FORM  4.2.1
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 == (SIZEOFFUNCTION-FUNCTION)
947  || n == (NUMFACTORS-FUNCTION)
948  || n == (GCDFUNCTION-FUNCTION)
949  || n == (DIVFUNCTION-FUNCTION)
950  || n == (REMFUNCTION-FUNCTION)
951  || n == (INVERSEFUNCTION-FUNCTION)
952  || n == (MULFUNCTION-FUNCTION)
953  || n == (FACTORIN-FUNCTION)
954  || n == (FIRSTTERM-FUNCTION)
955  || n == (CONTENTTERM-FUNCTION) )
956  && fill[-1] == TFUNOPEN ) {
957  v = s+1;
958  if ( *v == TEXPRESSION ) {
959  v++;
960  n = 0; while ( *v >= 0 ) n = 128*n + *v++;
961  if ( v == t ) {
962  *t = TEMPTY; s++;
963  }
964  }
965  }
966  }
967  }
968  }
969  if ( ( fill > to )
970  && ( ( fill[-1] == TFUNOPEN || fill[-1] == TCOMMA )
971  && ( t[1] == TFUNCLOSE || t[1] == TCOMMA ) ) ) {
972  v = s + 1;
973  switch ( *v ) {
974  case TMINUS:
975  v++;
976  if ( *v == TVECTOR ) {
977  w = v+1; while ( *w >= 0 ) w++;
978  if ( w == t ) {
979  *t = TEMPTY; s++;
980  }
981  }
982  else {
983  if ( *v == TNUMBER || *v == TNUMBER1 ) {
984  if ( BITSINWORD == 16 ) { ULONG x; WORD base;
985  base = ( *v == TNUMBER ) ? 100: 128;
986  vv = v+1; x = 0; while ( *vv >= 0 ) { x = x*base + *vv++; }
987  if ( ( vv != t ) || ( ( vv - v ) > 4 ) || ( x > (MAXPOSITIVE+1) ) )
988  *fill++ = *s++;
989  else { *t = TEMPTY; s++; break; }
990  }
991  else if ( BITSINWORD == 32 ) { ULONG x; WORD base;
992  base = ( *v == TNUMBER ) ? 100: 128;
993  vv = v+1; x = 0; while ( *vv >= 0 ) { x = x*base + *vv++; }
994  if ( ( vv != t ) || ( ( vv - v ) > 6 ) || ( x > (MAXPOSITIVE+1) ) )
995  *fill++ = *s++;
996  else { *t = TEMPTY; s++; break; }
997  }
998  else {
999  if ( ( v+2 == t ) || ( v+3 == t && v[2] >= 0 ) )
1000  { *t = TEMPTY; s++; break; }
1001  else *fill++ = *s++;
1002  }
1003  }
1004  else if ( *v == LPARENTHESIS && t[-1] == RPARENTHESIS ) {
1005  w = v; n = 0;
1006  while ( n >= 0 ) {
1007  w++;
1008  if ( *w == LPARENTHESIS ) n++;
1009  else if ( *w == RPARENTHESIS ) n--;
1010  }
1011  if ( w == ( t-1 ) ) { *t = TEMPTY; s++; }
1012  else *fill++ = *s++;
1013  }
1014  else *fill++ = *s++;
1015  break;
1016  }
1017  /* fall through */
1018  case TSETNUM:
1019  v++; while ( *v >= 0 ) v++;
1020  goto tcommon;
1021  case TSYMBOL:
1022  if ( ( v[1] == COEFFSYMBOL || v[1] == NUMERATORSYMBOL
1023  || v[1] == DENOMINATORSYMBOL ) && v[2] < 0 ) {
1024  *fill++ = *s++; break;
1025  }
1026  /* fall through */
1027  case TSET:
1028  case TVECTOR:
1029  case TINDEX:
1030  case TFUNCTION:
1031  case TDOLLAR:
1032  case TDUBIOUS:
1033  case TSGAMMA:
1034 tcommon: v++; while ( *v >= 0 ) v++;
1035  if ( v == t || ( v[0] == TWILDCARD && v+1 == t ) )
1036  { *t = TEMPTY; s++; }
1037  else *fill++ = *s++;
1038  break;
1039  case TGENINDEX:
1040  v++;
1041  if ( v == t ) { *t = TEMPTY; s++; }
1042  else *fill++ = *s++;
1043  break;
1044  case TNUMBER:
1045  case TNUMBER1:
1046  if ( BITSINWORD == 16 ) { ULONG x; WORD base;
1047  base = ( *v == TNUMBER ) ? 100: 128;
1048  vv = v+1; x = 0; while ( *vv >= 0 ) { x = x*base + *vv++; }
1049  if ( ( vv != t ) || ( ( vv - v ) > 4 ) || ( x > MAXPOSITIVE ) )
1050  *fill++ = *s++;
1051  else { *t = TEMPTY; s++; break; }
1052  }
1053  else if ( BITSINWORD == 32 ) { ULONG x; WORD base;
1054  base = ( *v == TNUMBER ) ? 100: 128;
1055  vv = v+1; x = 0; while ( *vv >= 0 ) { x = x*base + *vv++; }
1056  if ( ( vv != t ) || ( ( vv - v ) > 6 ) || ( x > MAXPOSITIVE ) )
1057  *fill++ = *s++;
1058  else { *t = TEMPTY; s++; break; }
1059  }
1060  else {
1061  if ( ( v+2 == t ) || ( v+3 == t && v[2] >= 0 ) )
1062  { *t = TEMPTY; s++; break; }
1063  else *fill++ = *s++;
1064  }
1065  break;
1066  case TWILDARG:
1067  v++; while ( *v >= 0 ) v++;
1068  if ( v == t ) { *t = TEMPTY; s++; }
1069  else *fill++ = *s++;
1070  break;
1071  case TEXPRESSION:
1072 /*
1073  First establish that there is only the expression
1074  in this argument.
1075 */
1076  vv = s+1;
1077  while ( vv < t ) {
1078  if ( *vv != TEXPRESSION ) break;
1079  vv++; while ( *vv >= 0 ) vv++;
1080  }
1081  if ( vv < t ) { *fill++ = *s++; break; }
1082 /*
1083  Find the function
1084 */
1085  w = fill-1; n = 0;
1086  while ( n >= 0 && w >= to ) {
1087  if ( *w == TFUNOPEN ) n--;
1088  else if ( *w == TFUNCLOSE ) n++;
1089  w--;
1090  }
1091  w--; while ( w > to && *w >= 0 ) w--;
1092  if ( *w != TFUNCTION ) { *fill++ = *s++; break; }
1093  w++; n = 0;
1094  while ( *w >= 0 ) { n = 128*n + *w++; }
1095  if ( n == GCDFUNCTION-FUNCTION
1096  || n == DIVFUNCTION-FUNCTION
1097  || n == REMFUNCTION-FUNCTION
1098  || n == INVERSEFUNCTION-FUNCTION
1099  || n == MULFUNCTION-FUNCTION ) {
1100  *t = TEMPTY; s++;
1101  }
1102  else *fill++ = *s++;
1103  break;
1104  default: *fill++ = *s++; break;
1105  }
1106  }
1107  else *fill++ = *s++;
1108  }
1109  else if ( *s == TEMPTY ) s++;
1110  else *fill++ = *s++;
1111  }
1112  *fill++ = TENDOFIT;
1113  return(error);
1114 }
1115 
1116 /*
1117  #] simp2token :
1118  #[ simp3atoken :
1119 
1120  We hunt for denominators and exponents that seem hidden.
1121  For the denominators we have to recognize:
1122  /fun /fun() /fun^power /fun()^power
1123  /set[n] /set[n]() /set[n]^power /set[n]()^power
1124  /symbol^power (power no number or symbol wildcard)
1125  /dotpr^power (id)
1126  /#^power (id)
1127  /() /()^power
1128  /vect /index /vect(anything) /vect(anything)^power
1129 */
1130 
1131 int simp3atoken(SBYTE *s, int mode)
1132 {
1133  int error = 0, n, numexp = 0, denom, base, numprot, i;
1134  SBYTE *t, c;
1135  LONG num;
1136  WORD *prot;
1137  if ( mode == RHSIDE ) {
1138  prot = AC.ProtoType;
1139  numprot = prot[1] - SUBEXPSIZE;
1140  prot += SUBEXPSIZE;
1141  }
1142  else { prot = 0; numprot = 0; }
1143  while ( *s != TENDOFIT ) {
1144  denom = 1;
1145  if ( *s == TDIVIDE ) { denom = -1; s++; }
1146  c = *s;
1147  switch(c) {
1148  case TSYMBOL:
1149  case TNUMBER:
1150  case TNUMBER1:
1151  s++; while ( *s >= 0 ) s++; /* skip the object */
1152  if ( *s == TWILDCARD ) s++; /* and the possible wildcard */
1153 dosymbol:
1154  if ( *s != TPOWER ) continue; /* No power -> done */
1155  s++; /* Skip the power */
1156  if ( *s == TMINUS ) s++; /* negative: no difference here */
1157  if ( *s == TNUMBER || *s == TNUMBER1 ) {
1158  base = *s == TNUMBER ? 100: 128; /* NUMBER = base 100 */
1159  s++; /* Now we compose the power */
1160  num = *s++; /* If the number is way too large */
1161  while ( *s >= 0 ) { /* it may look like not too big */
1162  if ( num > MAXPOWER ) break; /* Hence... */
1163  num = base*num + *s++;
1164  }
1165  while ( *s >= 0 ) s++; /* Finish the number if needed */
1166  if ( *s == TPOWER ) goto doublepower;
1167  if ( num <= MAXPOWER ) continue; /* Simple case */
1168  }
1169  else if ( *s == TSYMBOL && c != TNUMBER && c != TNUMBER1 ) {
1170  s++; n = 0; while ( *s >= 0 ) { n = 128*n + *s++; }
1171  if ( *s == TWILDCARD ) { s++;
1172  if ( *s == TPOWER ) goto doublepower;
1173  continue; }
1174 /*
1175  Now we have to test whether n happens to be a wildcard
1176 */
1177  if ( mode == RHSIDE ) {
1178  n += 2*MAXPOWER;
1179  for ( i = 0; i < numprot; i += 4 ) {
1180  if ( prot[i+2] == n && prot[i] == SYMTOSYM ) break;
1181  }
1182  if ( i < numprot ) break;
1183  }
1184  if ( *s == TPOWER ) goto doublepower;
1185  }
1186  numexp++;
1187  break;
1188  case TINDEX:
1189  s++; while ( *s >= 0 ) s++;
1190  if ( *s == TWILDCARD ) s++;
1191 doindex:
1192  if ( denom < 0 || *s == TPOWER ) {
1193  MesPrint("&Index to a power or in denominator is illegal");
1194  error = 1;
1195  }
1196  break;
1197  case TVECTOR:
1198  s++; while ( *s >= 0 ) s++;
1199  if ( *s == TWILDCARD ) s++;
1200 dovector:
1201  if ( *s == TFUNOPEN ) {
1202  s++; n = 1;
1203  for(;;) {
1204  if ( *s == TFUNOPEN ) {
1205  n++;
1206  MesPrint("&Illegal vector index");
1207  error = 1;
1208  }
1209  else if ( *s == TFUNCLOSE ) {
1210  n--;
1211  if ( n <= 0 ) break;
1212  }
1213  s++;
1214  }
1215  s++;
1216  }
1217  else if ( *s == TDOT ) goto dodot;
1218  if ( denom < 0 || *s == TPOWER || *s == TPOWER1 ) numexp++;
1219  break;
1220  case TFUNCTION:
1221  s++; while ( *s >= 0 ) s++;
1222  if ( *s == TWILDCARD ) s++;
1223 dofunction:
1224  t = s;
1225  if ( *t == TFUNOPEN ) {
1226  t++; n = 1;
1227  for(;;) {
1228  if ( *t == TFUNOPEN ) n++;
1229  else if ( *t == TFUNCLOSE ) { if ( --n <= 0 ) break; }
1230  t++;
1231  }
1232  t++; s++;
1233  }
1234  if ( denom < 0 || *t == TPOWER || *t == TPOWER1 ) numexp++;
1235  break;
1236  case TEXPRESSION:
1237  s++; while ( *s >= 0 ) s++;
1238  t = s;
1239  if ( *t == TFUNOPEN ) {
1240  t++; n = 1;
1241  for(;;) {
1242  if ( *t == TFUNOPEN ) n++;
1243  else if ( *t == TFUNCLOSE ) { if ( --n <= 0 ) break; }
1244  t++;
1245  }
1246  t++;
1247  }
1248  if ( *t == LBRACE ) {
1249  t++; n = 1;
1250  for(;;) {
1251  if ( *t == LBRACE ) n++;
1252  else if ( *t == RBRACE ) { if ( --n <= 0 ) break; }
1253  t++;
1254  }
1255  t++;
1256  }
1257  if ( denom < 0 || ( ( *t == TPOWER || *t == TPOWER1 )
1258  && t[1] == TMINUS ) ) numexp++;
1259  break;
1260  case TDOLLAR:
1261  s++; while ( *s >= 0 ) s++;
1262  if ( denom < 0 || ( ( *s == TPOWER || *s == TPOWER1 )
1263  && s[1] == TMINUS ) ) numexp++;
1264  break;
1265  case LPARENTHESIS:
1266  s++; n = 1; t = s;
1267  for(;;) {
1268  if ( *t == LPARENTHESIS ) n++;
1269  else if ( *t == RPARENTHESIS ) { if ( --n <= 0 ) break; }
1270  t++;
1271  }
1272  t++;
1273  if ( denom > 0 && ( *t == TPOWER || *t == TPOWER1 ) ) {
1274  if ( ( t[1] == TNUMBER || t[1] == TNUMBER1 ) && t[2] >= 0
1275  && t[3] < 0 ) break;
1276  numexp++;
1277  }
1278  else if ( denom < 0 && ( *t == TPOWER || *t == TPOWER1 ) ) {
1279  if ( t[1] == TMINUS && ( t[2] == TNUMBER
1280  || t[2] == TNUMBER1 ) && t[3] >= 0
1281  && t[4] < 0 ) break;
1282  numexp++;
1283  }
1284  else if ( denom < 0 || ( ( *t == TPOWER || *t == TPOWER1 )
1285  && ( t[1] == TMINUS || t[1] == LPARENTHESIS ) ) ) numexp++;
1286  break;
1287  case TSET:
1288  s++; n = *s++; while ( *s >= 0 ) { n = 128*n + *s++; }
1289  n = Sets[n].type;
1290  switch ( n ) {
1291  case CSYMBOL: goto dosymbol;
1292  case CINDEX: goto doindex;
1293  case CVECTOR: goto dovector;
1294  case CFUNCTION: goto dofunction;
1295  case CNUMBER: goto dosymbol;
1296  default: error = 1; break;
1297  }
1298  break;
1299  case TDOT:
1300 dodot: s++;
1301  if ( *s == TVECTOR ) { s++; while ( *s >= 0 ) s++; }
1302  else if ( *s == TSET ) {
1303  s++; n = *s++; while ( *s >= 0 ) { n = 128*n + *s++; }
1304  if ( Sets[n].type != CVECTOR ) {
1305  MesPrint("&Set in dotproduct is not a set of vectors");
1306  error = 1;
1307  }
1308  if ( *s == LBRACE ) {
1309  s++; n = 1;
1310  for(;;) {
1311  if ( *s == LBRACE ) n++;
1312  else if ( *s == RBRACE ) { if ( --n <= 0 ) break; }
1313  s++;
1314  }
1315  s++;
1316  }
1317  else {
1318  MesPrint("&Set without argument in dotproduct");
1319  error = 1;
1320  }
1321  }
1322  else if ( *s == TSETNUM ) {
1323  s++; n = *s++; while ( *s >= 0 ) { n = 128*n + *s++; }
1324  if ( *s != TVECTOR ) goto nodot;
1325  s++; n = *s++; while ( *s >= 0 ) { n = 128*n + *s++; }
1326  if ( Sets[n].type != CVECTOR ) {
1327  MesPrint("&Set in dotproduct is not a set of vectors");
1328  error = 1;
1329  }
1330  }
1331  else {
1332 nodot: MesPrint("&Illegal second element in dotproduct");
1333  error = 1;
1334  s++; while ( *s >= 0 ) s++;
1335  }
1336  goto dosymbol;
1337  default:
1338  s++; while ( *s >= 0 ) s++;
1339  break;
1340  }
1341  }
1342  if ( error ) return(-1);
1343  return(numexp);
1344 doublepower:
1345  MesPrint("&Dubious notation with object^power1^power2");
1346  return(-1);
1347 }
1348 
1349 /*
1350  #] simp3atoken :
1351  #[ simp3btoken :
1352 */
1353 
1354 int simp3btoken(SBYTE *s, int mode)
1355 {
1356  int error = 0, i, numprot, n, denom, base, inset = 0, dotp, sube = 0;
1357  SBYTE *t, c, *fill, *ff, *ss;
1358  LONG num;
1359  WORD *prot;
1360  if ( mode == RHSIDE ) {
1361  prot = AC.ProtoType;
1362  numprot = prot[1] - SUBEXPSIZE;
1363  prot += SUBEXPSIZE;
1364  }
1365  else { prot = 0; numprot = 0; }
1366  fill = s;
1367  while ( *s == TEMPTY ) s++;
1368  while ( *s != TENDOFIT ) {
1369  if ( *s == TEMPTY ) { s++; continue; }
1370  denom = 1;
1371  if ( *s == TDIVIDE ) { denom = -1; *fill++ = *s++; }
1372  ff = fill; ss = s; c = *s;
1373  if ( c == TSETNUM ) {
1374  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1375  c = *s;
1376  }
1377  dotp = 0;
1378  switch(c) {
1379  case TSYMBOL:
1380  case TNUMBER:
1381  case TNUMBER1:
1382  *fill++ = *s++;
1383  while ( *s >= 0 ) *fill++ = *s++;
1384  if ( *s == TWILDCARD ) *fill++ = *s++;
1385 dosymbol:
1386  t = s;
1387  if ( *s != TPOWER ) continue;
1388  *fill++ = *s++;
1389  if ( *s == TMINUS ) *fill++ = *s++;
1390  if ( *s == TPLUS ) s++;
1391  if ( *s == TSETNUM ) {
1392  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1393  inset = 1;
1394  }
1395  else inset = 0;
1396  if ( *s == TNUMBER || *s == TNUMBER1 ) {
1397  base = *s == TNUMBER ? 100: 128;
1398  *fill++ = *s++;
1399  num = *s++; *fill++ = num;
1400  while ( *s >= 0 ) {
1401  if ( num > MAXPOWER ) break;
1402  *fill++ = *s;
1403  num = base*num + *s++;
1404  }
1405  while ( *s >= 0 ) *fill++ = *s++;
1406  if ( num <= MAXPOWER ) continue;
1407  goto putexp1;
1408  }
1409  else if ( *s == TSYMBOL && c != TNUMBER && c != TNUMBER1 ) {
1410  *fill++ = *s++;
1411  n = 0; while ( *s >= 0 ) { n = 128*n + *s; *fill++ = *s++; }
1412  if ( *s == TWILDCARD ) { *fill++ = *s++;
1413  if ( *s == TPOWER ) goto doublepower;
1414  break; }
1415 /*
1416  Now we have to test whether n happens to be a wildcard
1417 */
1418  if ( mode == RHSIDE && inset == 0 ) {
1419 /* n += WILDOFFSET;*/
1420  for ( i = 0; i < numprot; i += 4 ) {
1421  if ( prot[i+2] == n && prot[i] == SYMTOSYM ) break;
1422  }
1423  if ( i < numprot ) break;
1424  }
1425 
1426 putexp1: fill = ff;
1427  if ( denom < 0 ) fill[-1] = TMULTIPLY;
1428  *fill++ = TFUNCTION; *fill++ = (SBYTE)(AM.expnum); *fill++ = TFUNOPEN;
1429  if ( dotp ) *fill++ = LPARENTHESIS;
1430  while ( ss < t ) *fill++ = *ss++;
1431  if ( dotp ) *fill++ = RPARENTHESIS;
1432  *fill++ = TCOMMA;
1433  ss++; /* Skip TPOWER */
1434  if ( *ss == TMINUS ) { denom = -denom; ss++; }
1435  if ( denom < 0 ) {
1436  *fill++ = LPARENTHESIS;
1437  *fill++ = TMINUS;
1438  while ( ss < s ) *fill++ = *ss++;
1439  *fill++ = RPARENTHESIS;
1440  }
1441  else {
1442  while ( ss < s ) *fill++ = *ss++;
1443  }
1444  *fill++ = TFUNCLOSE;
1445  if ( *ss == TPOWER ) goto doublepower;
1446  }
1447  else { /* other objects can be composite */
1448  goto dofunpower;
1449  }
1450  break;
1451  case TINDEX:
1452  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1453  if ( *s == TWILDCARD ) *fill++ = *s++;
1454  break;
1455  case TVECTOR:
1456  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1457  if ( *s == TWILDCARD ) *fill++ = *s++;
1458 dovector:
1459  if ( *s == TFUNOPEN ) {
1460  while ( *s != TFUNCLOSE ) *fill++ = *s++;
1461  *fill++ = *s++;
1462  }
1463  else if ( *s == TDOT ) goto dodot;
1464  t = s;
1465  goto dofunpower;
1466  case TFUNCTION:
1467  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1468  if ( *s == TWILDCARD ) *fill++ = *s++;
1469 dofunction:
1470  t = s;
1471  if ( *t == TFUNOPEN ) {
1472  t++; n = 1;
1473  for(;;) {
1474  if ( *t == TFUNOPEN ) n++;
1475  else if ( *t == TFUNCLOSE ) { if ( --n <= 0 ) break; }
1476  t++;
1477  }
1478  t++; *fill++ = *s++;
1479  }
1480  sube = 0;
1481 dofunpower:
1482  if ( *t == TPOWER || *t == TPOWER1 ) {
1483  if ( sube ) {
1484  if ( ( t[1] == TNUMBER || t[1] == TNUMBER1 )
1485  && denom > 0 ) {
1486  if ( t[2] >= 0 && t[3] < 0 ) { sube = 0; break; }
1487  }
1488  else if ( t[1] == TMINUS && denom < 0 &&
1489  ( t[2] == TNUMBER || t[2] == TNUMBER1 ) ) {
1490  if ( t[2] >= 0 && t[3] < 0 ) { sube = 0; break; }
1491  }
1492  sube = 0;
1493  }
1494  fill = ff;
1495  *fill++ = TFUNCTION; *fill++ = (SBYTE)(AM.expnum); *fill++ = TFUNOPEN;
1496  *fill++ = LPARENTHESIS;
1497  while ( ss < t ) *fill++ = *ss++;
1498  t++;
1499  *fill++ = RPARENTHESIS; *fill++ = TCOMMA;
1500  if ( *t == TMINUS ) { t++; denom = -denom; }
1501  *fill++ = LPARENTHESIS;
1502  if ( denom < 0 ) *fill++ = TMINUS;
1503  if ( *t == LPARENTHESIS ) {
1504  *fill++ = *t++; n = 0;
1505  while ( n >= 0 ) {
1506  if ( *t == LPARENTHESIS ) n++;
1507  else if ( *t == RPARENTHESIS ) n--;
1508  *fill++ = *t++;
1509  }
1510  }
1511  else if ( *t == TFUNCTION || *t == TDUBIOUS ) {
1512  *fill++ = *t++; while ( *t >= 0 ) *fill++ = *t++;
1513  if ( *t == TWILDCARD ) *fill++ = *t++;
1514  if ( *t == TFUNOPEN ) {
1515  *fill++ = *t++; n = 0;
1516  while ( n >= 0 ) {
1517  if ( *t == TFUNOPEN ) n++;
1518  else if ( *t == TFUNCLOSE ) n--;
1519  *fill++ = *t++;
1520  }
1521  }
1522  }
1523  else if ( *t == TSET ) {
1524  *fill++ = *t++; n = 0;
1525  while ( *t >= 0 ) { n = 128*n + *t; *fill++ = *t++; }
1526  if ( *t == LBRACE ) {
1527  if ( n < AM.NumFixedSets || Sets[n].type == CRANGE ) {
1528  MesPrint("&This type of usage of sets is not allowed");
1529  error = 1;
1530  }
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 == TEXPRESSION ) {
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  if ( *t == LBRACE ) {
1550  *fill++ = *t++; n = 0;
1551  while ( n >= 0 ) {
1552  if ( *t == LBRACE ) n++;
1553  else if ( *t == RBRACE ) n--;
1554  *fill++ = *t++;
1555  }
1556  }
1557  }
1558  else if ( *t == TVECTOR ) {
1559  *fill++ = *t++; while ( *t >= 0 ) *fill++ = *t++;
1560  if ( *t == TFUNOPEN ) {
1561  *fill++ = *t++; n = 0;
1562  while ( n >= 0 ) {
1563  if ( *t == TFUNOPEN ) n++;
1564  else if ( *t == TFUNCLOSE ) n--;
1565  *fill++ = *t++;
1566  }
1567  }
1568  else if ( *t == TDOT ) {
1569  *fill++ = *t++;
1570  if ( *t == TVECTOR || *t == TDUBIOUS ) {
1571  *fill++ = *t++; while ( *t >= 0 ) *fill++ = *t++;
1572  }
1573  else if ( *t == TSET ) {
1574  *fill++ = *t++; num = 0;
1575  while ( *t >= 0 ) { num = 128*num + *t; *fill++ = *t++; }
1576  if ( Sets[num].type != CVECTOR ) {
1577  MesPrint("&Illegal set type in dotproduct");
1578  error = 1;
1579  }
1580  if ( *t == LBRACE ) {
1581  *fill++ = *t++; n = 0;
1582  while ( n >= 0 ) {
1583  if ( *t == LBRACE ) n++;
1584  else if ( *t == RBRACE ) n--;
1585  *fill++ = *t++;
1586  }
1587  }
1588  }
1589  else if ( *t == TSETNUM ) {
1590  *fill++ = *t++;
1591  while ( *t >= 0 ) { *fill++ = *t++; }
1592  *fill++ = *t++;
1593  while ( *t >= 0 ) { *fill++ = *t++; }
1594  }
1595  }
1596  else {
1597  MesPrint("&Illegal second element in dotproduct");
1598  error = 1;
1599  }
1600  }
1601  else {
1602  *fill++ = *t++; while ( *t >= 0 ) *fill++ = *t++;
1603  if ( *t == TWILDCARD ) *fill++ = *t++;
1604  }
1605  *fill++ = RPARENTHESIS; *fill++ = TFUNCLOSE;
1606  if ( *t == TPOWER ) goto doublepower;
1607  while ( fill > ff ) *--t = *--fill;
1608  s = t;
1609  }
1610  else if ( denom < 0 ) {
1611  fill = ff; ff[-1] = TMULTIPLY;
1612  *fill++ = TFUNCTION; *fill++ = (SBYTE)(AM.denomnum);
1613  *fill++ = TFUNOPEN; *fill++ = LPARENTHESIS;
1614  while ( ss < t ) *fill++ = *ss++;
1615  *fill++ = RPARENTHESIS; *fill++ = TFUNCLOSE;
1616  while ( fill > ff ) *--t = *--fill;
1617  s = t; denom = 1; sube = 0;
1618  break;
1619  }
1620  sube = 0;
1621  break;
1622  case TEXPRESSION:
1623  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1624  t = s;
1625  if ( *t == TFUNOPEN ) {
1626  t++; n = 1;
1627  for(;;) {
1628  if ( *t == TFUNOPEN ) n++;
1629  else if ( *t == TFUNCLOSE ) { if ( --n <= 0 ) break; }
1630  t++;
1631  }
1632  t++;
1633  }
1634  if ( *t == LBRACE ) {
1635  t++; n = 1;
1636  for(;;) {
1637  if ( *t == LBRACE ) n++;
1638  else if ( *t == RBRACE ) { if ( --n <= 0 ) break; }
1639  t++;
1640  }
1641  t++;
1642  }
1643  if ( t > s || denom < 0 || ( ( *t == TPOWER || *t == TPOWER1 )
1644  && t[1] == TMINUS ) ) goto dofunpower;
1645  else goto dosymbol;
1646  case TDOLLAR:
1647  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1648  goto dosymbol;
1649  case LPARENTHESIS:
1650  *fill++ = *s++; n = 1; t = s;
1651  for(;;) {
1652  if ( *t == LPARENTHESIS ) n++;
1653  else if ( *t == RPARENTHESIS ) { if ( --n <= 0 ) break; }
1654  t++;
1655  }
1656  t++; sube = 1;
1657  goto dofunpower;
1658  case TSET:
1659  *fill++ = *s++; n = *s++; *fill++ = (SBYTE)n;
1660  while ( *s >= 0 ) { *fill++ = *s; n = 128*n + *s++; }
1661  n = Sets[n].type;
1662  switch ( n ) {
1663  case CSYMBOL: goto dosymbol;
1664  case CINDEX: break;
1665  case CVECTOR: goto dovector;
1666  case CFUNCTION: goto dofunction;
1667  case CNUMBER: goto dosymbol;
1668  default: error = 1; break;
1669  }
1670  break;
1671  case TDOT:
1672 dodot: *fill++ = *s++;
1673  if ( *s == TVECTOR ) {
1674  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1675  }
1676  else if ( *s == TSET ) {
1677  *fill++ = *s++; n = *s++; *fill++ = (SBYTE)n;
1678  while ( *s >= 0 ) { *fill++ = *s; n = 128*n + *s++; }
1679  if ( *s == LBRACE ) {
1680  if ( n < AM.NumFixedSets || Sets[n].type == CRANGE ) {
1681  MesPrint("&This type of usage of sets is not allowed");
1682  error = 1;
1683  }
1684  *fill++ = *s++; n = 1;
1685  for(;;) {
1686  if ( *s == LBRACE ) n++;
1687  else if ( *s == RBRACE ) { if ( --n <= 0 ) break; }
1688  *fill++ = *s++;
1689  }
1690  *fill++ = *s++;
1691  }
1692  else {
1693  MesPrint("&Set without argument in dotproduct");
1694  error = 1;
1695  }
1696  }
1697  else if ( *s == TSETNUM ) {
1698  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1699  if ( *s != TVECTOR ) goto nodot;
1700  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1701  }
1702  else {
1703 nodot: MesPrint("&Illegal second element in dotproduct");
1704  error = 1;
1705  *fill++ = *s++;
1706  while ( *s >= 0 ) *fill++ = *s++;
1707  }
1708  dotp = 1;
1709  goto dosymbol;
1710  default:
1711  *fill++ = *s++;
1712  while ( *s >= 0 ) *fill++ = *s++;
1713  break;
1714  }
1715  }
1716  *fill = TENDOFIT;
1717  return(error);
1718 doublepower:;
1719  MesPrint("&Dubious notation with power of power");
1720  return(-1);
1721 }
1722 
1723 /*
1724  #] simp3btoken :
1725  #[ simp4token :
1726 
1727  Deal with the set[n] objects in the RHS.
1728 */
1729 
1730 int simp4token(SBYTE *s)
1731 {
1732  int error = 0, n, nsym, settype;
1733  WORD i, *w, *wstop, level;
1734  SBYTE *const s0 = s;
1735  SBYTE *fill = s, *s1, *s2, *s3, type, s1buf[10];
1736  SBYTE *tbuf = s, *t, *t1;
1737 
1738  while ( *s != TENDOFIT ) {
1739  if ( *s != TSET ) {
1740  if ( *s == TEMPTY ) s++;
1741  else *fill++ = *s++;
1742  continue;
1743  }
1744  if ( fill >= (s0+1) && fill[-1] == TWILDCARD ) { *fill++ = *s++; continue; }
1745  if ( fill >= (s0+2) && fill[-1] == TNOT && fill[-2] == TWILDCARD ) { *fill++ = *s++; continue; }
1746  s1 = s++; n = 0; while ( *s >= 0 ) { n = 128*n + *s++; }
1747  i = Sets[n].type;
1748  if ( *s != LBRACE ) { while ( s1 < s ) *fill++ = *s1++; continue; }
1749  if ( n < AM.NumFixedSets || i == CRANGE ) {
1750  MesPrint("&It is not allowed to refer to individual elements of built in or ranged sets");
1751  error = 1;
1752  }
1753  s++;
1754  if ( *s != TSYMBOL && *s != TDOLLAR ) {
1755  MesPrint("&Set index in RHS is not a wildcard symbol or $-variable");
1756  error = 1;
1757  while ( s1 < s ) *fill++ = *s1++;
1758  continue;
1759  }
1760  settype = ( *s == TDOLLAR );
1761  s++; nsym = 0; s2 = s;
1762  while ( *s >= 0 ) nsym = 128*nsym + *s++;
1763  if ( *s != RBRACE ) {
1764  MesPrint("&Improper set argument in RHS");
1765  error = 1;
1766  while ( s1 < s ) *fill++ = *s1++;
1767  continue;
1768  }
1769  s++;
1770 /*
1771  Verify that nsym is a wildcard
1772 */
1773  if ( !settype ) {
1774  w = AC.ProtoType; wstop = w + w[1]; w += SUBEXPSIZE;
1775  while ( w < wstop ) {
1776  if ( *w == SYMTOSYM && w[2] == nsym ) break;
1777  w += w[1];
1778  }
1779  if ( w >= wstop ) {
1780 /*
1781  It could still be a summation parameter!
1782 */
1783  t = fill - 1;
1784  while ( t >= tbuf ) {
1785  if ( *t == TFUNCLOSE ) {
1786  level = 1; t--;
1787  while ( t >= tbuf ) {
1788  if ( *t == TFUNCLOSE ) level++;
1789  else if ( *t == TFUNOPEN ) {
1790  level--;
1791  if ( level == 0 ) break;
1792  }
1793  t--;
1794  }
1795  }
1796  else if ( *t == RBRACE ) {
1797  level = 1; t--;
1798  while ( t >= tbuf ) {
1799  if ( *t == RBRACE ) level++;
1800  else if ( *t == LBRACE ) {
1801  level--;
1802  if ( level == 0 ) break;
1803  }
1804  t--;
1805  }
1806  }
1807  else if ( *t == RPARENTHESIS ) {
1808  level = 1; t--;
1809  while ( t >= tbuf ) {
1810  if ( *t == RPARENTHESIS ) level++;
1811  else if ( *t == LPARENTHESIS ) {
1812  level--;
1813  if ( level == 0 ) break;
1814  }
1815  t--;
1816  }
1817  }
1818  else if ( *t == TFUNOPEN ) {
1819  t1 = t-1;
1820  while ( *t1 > 0 && t1 > tbuf ) t1--;
1821  if ( *t1 == TFUNCTION ) {
1822  t1++; level = 0;
1823  while ( *t1 > 0 ) level = level*128+*t1++;
1824  if ( level == (SUMF1-FUNCTION)
1825  || level == (SUMF2-FUNCTION) ) {
1826  t1 = t + 1;
1827  if ( *t1 == LPARENTHESIS ) t1++;
1828  if ( *t1 == TSYMBOL ) {
1829  if ( ( t1[1] == COEFFSYMBOL
1830  || t1[1] == NUMERATORSYMBOL
1831  || t1[1] == DENOMINATORSYMBOL )
1832  && t1[2] < 0 ) {}
1833  else {
1834  t1++; level = 0;
1835  while ( *t1 >= 0 && t1 < fill ) level = 128*level + *t1++;
1836  if ( level == nsym && t1 < fill ) {
1837  if ( t[1] == LPARENTHESIS
1838  && *t1 == RPARENTHESIS && t1[1] == TCOMMA ) break;
1839  if ( t[1] != LPARENTHESIS && *t1 == TCOMMA ) break;
1840  }
1841  }
1842  }
1843  }
1844  }
1845  }
1846  t--;
1847  }
1848  if ( t < tbuf ) {
1849  fill--;
1850  MesPrint("&Set index in RHS is not a wildcard symbol");
1851  error = 1;
1852  while ( s1 < s ) *fill++ = *s1++;
1853  continue;
1854  }
1855  }
1856  }
1857 /*
1858  Now replace by a set marker: TSETNUM,nsym,TYPE,setnumber
1859 */
1860  switch ( i ) {
1861  case CSYMBOL: type = TSYMBOL; break;
1862  case CINDEX: type = TINDEX; break;
1863  case CVECTOR: type = TVECTOR; break;
1864  case CFUNCTION: type = TFUNCTION; break;
1865  case CNUMBER: type = TNUMBER1; break;
1866  case CDUBIOUS: type = TDUBIOUS; break;
1867  default:
1868  MesPrint("&Unknown set type in simp4token");
1869  error = 1; type = CDUBIOUS; break;
1870  }
1871  s3 = s1buf; s1++;
1872  while ( *s1 >= 0 ) *s3++ = *s1++;
1873  *s3 = -1; s1 = s1buf;
1874  if ( settype ) *fill++ = TSETDOL;
1875  else *fill++ = TSETNUM;
1876  while ( *s2 >= 0 ) *fill++ = *s2++;
1877  *fill++ = type; while ( *s1 >= 0 ) *fill++ = *s1++;
1878  }
1879  *fill++ = TENDOFIT;
1880  return(error);
1881 }
1882 
1883 /*
1884  #] simp4token :
1885  #[ simp5token :
1886 
1887  Making sure that first argument of sumfunction is not a wildcard already
1888 */
1889 
1890 int simp5token(SBYTE *s, int mode)
1891 {
1892  int error = 0, n, type;
1893  WORD *w, *wstop;
1894  if ( mode == RHSIDE ) {
1895  while ( *s != TENDOFIT ) {
1896  if ( *s == TFUNCTION ) {
1897  s++; n = 0; while ( *s >= 0 ) n = 128*n + *s++;
1898  if ( n == AM.sumnum || n == AM.sumpnum ) {
1899  if ( *s != TFUNOPEN ) continue;
1900  s++;
1901  if ( *s != TSYMBOL && *s != TINDEX ) continue;
1902  type = *s++;
1903  n = 0; while ( *s >= 0 ) n = 128*n + *s++;
1904  if ( type == TINDEX ) n += AM.OffsetIndex;
1905  if ( *s != TCOMMA ) continue;
1906  w = AC.ProtoType;
1907  wstop = w + w[1];
1908  w += SUBEXPSIZE;
1909  while ( w < wstop ) {
1910  if ( w[2] == n ) {
1911  if ( ( type == TSYMBOL && ( w[0] == SYMTOSYM
1912  || w[0] == SYMTONUM || w[0] == SYMTOSUB ) ) || (
1913  type == TINDEX && ( w[0] == INDTOIND
1914  || w[0] == INDTOSUB ) ) ) {
1915  error = 1;
1916  MesPrint("&Parameter of sum function is already a wildcard");
1917  }
1918  }
1919  w += w[1];
1920  }
1921  }
1922  }
1923  else s++;
1924  }
1925  }
1926  return(error);
1927 }
1928 
1929 /*
1930  #] simp5token :
1931  #[ simp6token :
1932 
1933  Making sure that factorized expressions are used properly
1934 */
1935 
1936 int simp6token(SBYTE *tokens, int mode)
1937 {
1938 /* EXPRESSIONS e = Expressions; */
1939  int error = 0, n;
1940  int level = 0, haveone = 0;
1941  SBYTE *s = tokens, *ss;
1942  LONG numterms;
1943  WORD funnum = 0;
1944  GETIDENTITY
1945  if ( mode == RHSIDE ) {
1946  while ( *s == TPLUS || *s == TMINUS ) s++;
1947  numterms = 1;
1948  while ( *s != TENDOFIT ) {
1949  if ( *s == LPARENTHESIS ) level++;
1950  else if ( *s == RPARENTHESIS ) level--;
1951  else if ( *s == TFUNOPEN ) level++;
1952  else if ( *s == TFUNCLOSE ) level--;
1953  else if ( ( *s == TPLUS || *s == TMINUS ) && level == 0 ) {
1954 /*
1955  Special exception: x^-1 etc.
1956 */
1957  if ( s[-1] != TPOWER && s[-1] != TPLUS && s[-1] != TMINUS ) {
1958  numterms++;
1959  }
1960  }
1961  else if ( *s == TEXPRESSION ) {
1962  ss = s;
1963  s++; n = 0; while ( *s >= 0 ) n = 128*n + *s++;
1964 
1965  if ( Expressions[n].status == STOREDEXPRESSION ) {
1966  POSITION position;
1967 /*
1968 #ifdef WITHPTHREADS
1969  RENUMBER renumber;
1970 #endif
1971 */
1972  RENUMBER renumber;
1973 
1974  WORD TMproto[SUBEXPSIZE];
1975  TMproto[0] = EXPRESSION;
1976  TMproto[1] = SUBEXPSIZE;
1977  TMproto[2] = n;
1978  TMproto[3] = 1;
1979  { int ie; for ( ie = 4; ie < SUBEXPSIZE; ie++ ) TMproto[ie] = 0; }
1980  AT.TMaddr = TMproto;
1981  PUTZERO(position);
1982 /*
1983  if ( (
1984 #ifdef WITHPTHREADS
1985  renumber =
1986 #endif
1987  GetTable(n,&position,0) ) == 0 )
1988 */
1989  if ( ( renumber = GetTable(n,&position,0) ) == 0 )
1990  {
1991  error = 1;
1992  MesPrint("&Problems getting information about stored expression %s(4)"
1993  ,EXPRNAME(n));
1994  }
1995 /*
1996 #ifdef WITHPTHREADS
1997 */
1998  if ( renumber->symb.lo != AN.dummyrenumlist )
1999  M_free(renumber->symb.lo,"VarSpace");
2000  M_free(renumber,"Renumber");
2001 /*
2002 #endif
2003 */
2004  }
2005 
2006  if ( ( ( AS.Oldvflags[n] & ISFACTORIZED ) != 0 ) && *s != LBRACE ) {
2007  if ( level == 0 ) {
2008  haveone = 1;
2009  }
2010  else if ( error == 0 ) {
2011  if ( ss[-1] != TFUNOPEN || funnum != NUMFACTORS-FUNCTION ) {
2012  MesPrint("&Illegal use of factorized expression(s) in RHS");
2013  error = 1;
2014  }
2015  }
2016  }
2017  continue;
2018  }
2019  else if ( *s == TFUNCTION ) {
2020  s++; funnum = 0; while ( *s >= 0 ) funnum = 128*funnum + *s++;
2021  continue;
2022  }
2023  s++;
2024  }
2025  if ( haveone ) {
2026  if ( numterms > 1 ) {
2027  MesPrint("&Factorized expression in RHS in an expression of more than one term.");
2028  error = 1;
2029  }
2030  else if ( AC.ToBeInFactors == 0 ) {
2031  MesPrint("&Attempt to put a factorized expression inside an unfactorized expression.");
2032  error = 1;
2033  }
2034  }
2035  }
2036  return(error);
2037 }
2038 
2039 /*
2040  #] simp6token :
2041  #] Compiler :
2042 */
Definition: structs.h:497
VARRENUM symb
Definition: structs.h:180
WORD * lo
Definition: structs.h:167