FORM  4.2.1
compiler.c
Go to the documentation of this file.
1 
15 /* #[ License : */
16 /*
17  * Copyright (C) 1984-2017 J.A.M. Vermaseren
18  * When using this file you are requested to refer to the publication
19  * J.A.M.Vermaseren "New features of FORM" math-ph/0010025
20  * This is considered a matter of courtesy as the development was paid
21  * for by FOM the Dutch physics granting agency and we would like to
22  * be able to track its scientific use to convince FOM of its value
23  * for the community.
24  *
25  * This file is part of FORM.
26  *
27  * FORM is free software: you can redistribute it and/or modify it under the
28  * terms of the GNU General Public License as published by the Free Software
29  * Foundation, either version 3 of the License, or (at your option) any later
30  * version.
31  *
32  * FORM is distributed in the hope that it will be useful, but WITHOUT ANY
33  * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
34  * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
35  * details.
36  *
37  * You should have received a copy of the GNU General Public License along
38  * with FORM. If not, see <http://www.gnu.org/licenses/>.
39  */
40 /* #] License : */
41 /*
42  #[ includes :
43 */
44 
45 #include "form3.h"
46 
47 /*
48  com1commands are the commands of which only part of the word has to
49  be present. The order is rather important here.
50  com2commands are the commands that must have their whole word match.
51  here we can do a binary search.
52  {[(
53 */
54 
55 static KEYWORD com1commands[] = {
56  {"also", (TFUN)CoIdOld, STATEMENT, PARTEST}
57  ,{"abrackets", (TFUN)CoAntiBracket, TOOUTPUT, PARTEST}
58  ,{"antisymmetrize", (TFUN)CoAntiSymmetrize, STATEMENT, PARTEST}
59  ,{"antibrackets", (TFUN)CoAntiBracket, TOOUTPUT, PARTEST}
60  ,{"brackets", (TFUN)CoBracket, TOOUTPUT, PARTEST}
61  ,{"cfunctions", (TFUN)CoCFunction, DECLARATION, PARTEST|WITHAUTO}
62  ,{"commuting", (TFUN)CoCFunction, DECLARATION, PARTEST|WITHAUTO}
63  ,{"compress", (TFUN)CoCompress, DECLARATION, PARTEST}
64  ,{"ctensors", (TFUN)CoCTensor, DECLARATION, PARTEST|WITHAUTO}
65  ,{"cyclesymmetrize",(TFUN)CoCycleSymmetrize, STATEMENT, PARTEST}
66  ,{"dimension", (TFUN)CoDimension, DECLARATION, PARTEST}
67  ,{"discard", (TFUN)CoDiscard, STATEMENT, PARTEST}
68  ,{"functions", (TFUN)CoNFunction, DECLARATION, PARTEST|WITHAUTO}
69  ,{"format", (TFUN)CoFormat, TOOUTPUT, PARTEST}
70  ,{"fixindex", (TFUN)CoFixIndex, DECLARATION, PARTEST}
71  ,{"global", (TFUN)CoGlobal, DEFINITION, PARTEST}
72  ,{"gfactorized", (TFUN)CoGlobalFactorized, DEFINITION, PARTEST}
73  ,{"globalfactorized",(TFUN)CoGlobalFactorized,DEFINITION, PARTEST}
74  ,{"goto", (TFUN)CoGoTo, STATEMENT, PARTEST}
75  ,{"indexes", (TFUN)CoIndex, DECLARATION, PARTEST|WITHAUTO}
76  ,{"indices", (TFUN)CoIndex, DECLARATION, PARTEST|WITHAUTO}
77  ,{"identify", (TFUN)CoId, STATEMENT, PARTEST}
78  ,{"idnew", (TFUN)CoIdNew, STATEMENT, PARTEST}
79  ,{"idold", (TFUN)CoIdOld, STATEMENT, PARTEST}
80  ,{"local", (TFUN)CoLocal, DEFINITION, PARTEST}
81  ,{"lfactorized", (TFUN)CoLocalFactorized, DEFINITION, PARTEST}
82  ,{"localfactorized",(TFUN)CoLocalFactorized, DEFINITION, PARTEST}
83  ,{"load", (TFUN)CoLoad, DECLARATION, PARTEST}
84  ,{"label", (TFUN)CoLabel, STATEMENT, PARTEST}
85  ,{"modulus", (TFUN)CoModulus, DECLARATION, PARTEST}
86  ,{"multiply", (TFUN)CoMultiply, STATEMENT, PARTEST}
87  ,{"nfunctions", (TFUN)CoNFunction, DECLARATION, PARTEST|WITHAUTO}
88  ,{"nprint", (TFUN)CoNPrint, TOOUTPUT, PARTEST}
89  ,{"ntensors", (TFUN)CoNTensor, DECLARATION, PARTEST|WITHAUTO}
90  ,{"nwrite", (TFUN)CoNWrite, DECLARATION, PARTEST}
91  ,{"print", (TFUN)CoPrint, MIXED, 0}
92  ,{"redefine", (TFUN)CoRedefine, STATEMENT, 0}
93  ,{"rcyclesymmetrize",(TFUN)CoRCycleSymmetrize,STATEMENT, PARTEST}
94  ,{"symbols", (TFUN)CoSymbol, DECLARATION, PARTEST|WITHAUTO}
95  ,{"save", (TFUN)CoSave, DECLARATION, PARTEST}
96  ,{"symmetrize", (TFUN)CoSymmetrize, STATEMENT, PARTEST}
97  ,{"tensors", (TFUN)CoCTensor, DECLARATION, PARTEST|WITHAUTO}
98  ,{"unittrace", (TFUN)CoUnitTrace, DECLARATION, PARTEST}
99  ,{"vectors", (TFUN)CoVector, DECLARATION, PARTEST|WITHAUTO}
100  ,{"write", (TFUN)CoWrite, DECLARATION, PARTEST}
101 };
102 
103 static KEYWORD com2commands[] = {
104  {"antiputinside", (TFUN)CoAntiPutInside, STATEMENT, PARTEST}
105  ,{"apply", (TFUN)CoApply, STATEMENT, PARTEST}
106  ,{"aputinside", (TFUN)CoAntiPutInside, STATEMENT, PARTEST}
107  ,{"argexplode", (TFUN)CoArgExplode, STATEMENT, PARTEST}
108  ,{"argimplode", (TFUN)CoArgImplode, STATEMENT, PARTEST}
109  ,{"argtoextrasymbol",(TFUN)CoArgToExtraSymbol,STATEMENT, PARTEST}
110  ,{"argument", (TFUN)CoArgument, STATEMENT, PARTEST}
111  ,{"assign", (TFUN)CoAssign, STATEMENT, PARTEST}
112  ,{"auto", (TFUN)CoAuto, DECLARATION, PARTEST}
113  ,{"autodeclare", (TFUN)CoAuto, DECLARATION, PARTEST}
114  ,{"break", (TFUN)CoBreak, STATEMENT, PARTEST}
115  ,{"canonicalize", (TFUN)CoCanonicalize, STATEMENT, PARTEST}
116  ,{"case", (TFUN)CoCase, STATEMENT, PARTEST}
117  ,{"chainin", (TFUN)CoChainin, STATEMENT, PARTEST}
118  ,{"chainout", (TFUN)CoChainout, STATEMENT, PARTEST}
119  ,{"chisholm", (TFUN)CoChisholm, STATEMENT, PARTEST}
120  ,{"cleartable", (TFUN)CoClearTable, DECLARATION, PARTEST}
121  ,{"collect", (TFUN)CoCollect, SPECIFICATION,PARTEST}
122  ,{"commuteinset", (TFUN)CoCommuteInSet, DECLARATION, PARTEST}
123  ,{"contract", (TFUN)CoContract, STATEMENT, PARTEST}
124  ,{"copyspectator" ,(TFUN)CoCopySpectator, DEFINITION, PARTEST}
125  ,{"createspectator",(TFUN)CoCreateSpectator, DECLARATION, PARTEST}
126  ,{"ctable", (TFUN)CoCTable, DECLARATION, PARTEST}
127  ,{"deallocatetable",(TFUN)CoDeallocateTable, DECLARATION, PARTEST}
128  ,{"default", (TFUN)CoDefault, STATEMENT, PARTEST}
129  ,{"delete", (TFUN)CoDelete, SPECIFICATION,PARTEST}
130  ,{"denominators", (TFUN)CoDenominators, STATEMENT, PARTEST}
131  ,{"disorder", (TFUN)CoDisorder, STATEMENT, PARTEST}
132  ,{"do", (TFUN)CoDo, STATEMENT, PARTEST}
133  ,{"drop", (TFUN)CoDrop, SPECIFICATION,PARTEST}
134  ,{"dropcoefficient",(TFUN)CoDropCoefficient, STATEMENT, PARTEST}
135  ,{"dropsymbols", (TFUN)CoDropSymbols, STATEMENT, PARTEST}
136  ,{"else", (TFUN)CoElse, STATEMENT, PARTEST}
137  ,{"elseif", (TFUN)CoElseIf, STATEMENT, PARTEST}
138  ,{"emptyspectator", (TFUN)CoEmptySpectator, SPECIFICATION,PARTEST}
139  ,{"endargument", (TFUN)CoEndArgument, STATEMENT, PARTEST}
140  ,{"enddo", (TFUN)CoEndDo, STATEMENT, PARTEST}
141  ,{"endif", (TFUN)CoEndIf, STATEMENT, PARTEST}
142  ,{"endinexpression",(TFUN)CoEndInExpression, STATEMENT, PARTEST}
143  ,{"endinside", (TFUN)CoEndInside, STATEMENT, PARTEST}
144  ,{"endrepeat", (TFUN)CoEndRepeat, STATEMENT, PARTEST}
145  ,{"endswitch", (TFUN)CoEndSwitch, STATEMENT, PARTEST}
146  ,{"endterm", (TFUN)CoEndTerm, STATEMENT, PARTEST}
147  ,{"endwhile", (TFUN)CoEndWhile, STATEMENT, PARTEST}
148  ,{"exit", (TFUN)CoExit, STATEMENT, PARTEST}
149  ,{"extrasymbols", (TFUN)CoExtraSymbols, DECLARATION, PARTEST}
150  ,{"factarg", (TFUN)CoFactArg, STATEMENT, PARTEST}
151  ,{"factdollar", (TFUN)CoFactDollar, STATEMENT, PARTEST}
152  ,{"factorize", (TFUN)CoFactorize, TOOUTPUT, PARTEST}
153  ,{"fill", (TFUN)CoFill, DECLARATION, PARTEST}
154  ,{"fillexpression", (TFUN)CoFillExpression, DECLARATION, PARTEST}
155  ,{"frompolynomial", (TFUN)CoFromPolynomial, STATEMENT, PARTEST}
156  ,{"funpowers", (TFUN)CoFunPowers, DECLARATION, PARTEST}
157  ,{"hide", (TFUN)CoHide, SPECIFICATION,PARTEST}
158  ,{"if", (TFUN)CoIf, STATEMENT, PARTEST}
159  ,{"ifmatch", (TFUN)CoIfMatch, STATEMENT, PARTEST}
160  ,{"ifnomatch", (TFUN)CoIfNoMatch, STATEMENT, PARTEST}
161  ,{"ifnotmatch", (TFUN)CoIfNoMatch, STATEMENT, PARTEST}
162  ,{"inexpression", (TFUN)CoInExpression, STATEMENT, PARTEST}
163  ,{"inparallel", (TFUN)CoInParallel, SPECIFICATION,PARTEST}
164  ,{"inside", (TFUN)CoInside, STATEMENT, PARTEST}
165  ,{"insidefirst", (TFUN)CoInsideFirst, DECLARATION, PARTEST}
166  ,{"intohide", (TFUN)CoIntoHide, SPECIFICATION,PARTEST}
167  ,{"keep", (TFUN)CoKeep, SPECIFICATION,PARTEST}
168  ,{"makeinteger", (TFUN)CoMakeInteger, STATEMENT, PARTEST}
169  ,{"many", (TFUN)CoMany, STATEMENT, PARTEST}
170  ,{"merge", (TFUN)CoMerge, STATEMENT, PARTEST}
171  ,{"metric", (TFUN)CoMetric, DECLARATION, PARTEST}
172  ,{"moduleoption", (TFUN)CoModuleOption, ATENDOFMODULE,PARTEST}
173  ,{"multi", (TFUN)CoMulti, STATEMENT, PARTEST}
174  ,{"multibracket", (TFUN)CoMultiBracket, STATEMENT, PARTEST}
175  ,{"ndrop", (TFUN)CoNoDrop, SPECIFICATION,PARTEST}
176  ,{"nfactorize", (TFUN)CoNFactorize, TOOUTPUT, PARTEST}
177  ,{"nhide", (TFUN)CoNoHide, SPECIFICATION,PARTEST}
178  ,{"normalize", (TFUN)CoNormalize, STATEMENT, PARTEST}
179  ,{"notinparallel", (TFUN)CoNotInParallel, SPECIFICATION,PARTEST}
180  ,{"nskip", (TFUN)CoNoSkip, SPECIFICATION,PARTEST}
181  ,{"ntable", (TFUN)CoNTable, DECLARATION, PARTEST}
182  ,{"nunfactorize", (TFUN)CoNUnFactorize, TOOUTPUT, PARTEST}
183  ,{"nunhide", (TFUN)CoNoUnHide, SPECIFICATION,PARTEST}
184  ,{"off", (TFUN)CoOff, DECLARATION, PARTEST}
185  ,{"on", (TFUN)CoOn, DECLARATION, PARTEST}
186  ,{"once", (TFUN)CoOnce, STATEMENT, PARTEST}
187  ,{"only", (TFUN)CoOnly, STATEMENT, PARTEST}
188  ,{"polyfun", (TFUN)CoPolyFun, DECLARATION, PARTEST}
189  ,{"polyratfun", (TFUN)CoPolyRatFun, DECLARATION, PARTEST}
190  ,{"pophide", (TFUN)CoPopHide, SPECIFICATION,PARTEST}
191  ,{"print[]", (TFUN)CoPrintB, TOOUTPUT, PARTEST}
192  ,{"printtable", (TFUN)CoPrintTable, MIXED, PARTEST}
193  ,{"processbucketsize",(TFUN)CoProcessBucket, DECLARATION, PARTEST}
194  ,{"propercount", (TFUN)CoProperCount, DECLARATION, PARTEST}
195  ,{"pushhide", (TFUN)CoPushHide, SPECIFICATION,PARTEST}
196  ,{"putinside", (TFUN)CoPutInside, STATEMENT, PARTEST}
197  ,{"ratio", (TFUN)CoRatio, STATEMENT, PARTEST}
198  ,{"removespectator",(TFUN)CoRemoveSpectator, SPECIFICATION,PARTEST}
199  ,{"renumber", (TFUN)CoRenumber, STATEMENT, PARTEST}
200  ,{"repeat", (TFUN)CoRepeat, STATEMENT, PARTEST}
201  ,{"replaceloop", (TFUN)CoReplaceLoop, STATEMENT, PARTEST}
202  ,{"select", (TFUN)CoSelect, STATEMENT, PARTEST}
203  ,{"set", (TFUN)CoSet, DECLARATION, PARTEST}
204  ,{"setexitflag", (TFUN)CoSetExitFlag, STATEMENT, PARTEST}
205  ,{"shuffle", (TFUN)CoMerge, STATEMENT, PARTEST}
206  ,{"skip", (TFUN)CoSkip, SPECIFICATION,PARTEST}
207  ,{"sort", (TFUN)CoSort, STATEMENT, PARTEST}
208  ,{"splitarg", (TFUN)CoSplitArg, STATEMENT, PARTEST}
209  ,{"splitfirstarg", (TFUN)CoSplitFirstArg, STATEMENT, PARTEST}
210  ,{"splitlastarg", (TFUN)CoSplitLastArg, STATEMENT, PARTEST}
211  ,{"stuffle", (TFUN)CoStuffle, STATEMENT, PARTEST}
212  ,{"sum", (TFUN)CoSum, STATEMENT, PARTEST}
213  ,{"switch", (TFUN)CoSwitch, STATEMENT, PARTEST}
214  ,{"table", (TFUN)CoTable, DECLARATION, PARTEST}
215  ,{"tablebase", (TFUN)CoTableBase, DECLARATION, PARTEST}
216  ,{"tb", (TFUN)CoTableBase, DECLARATION, PARTEST}
217  ,{"term", (TFUN)CoTerm, STATEMENT, PARTEST}
218  ,{"testuse", (TFUN)CoTestUse, STATEMENT, PARTEST}
219  ,{"threadbucketsize",(TFUN)CoThreadBucket, DECLARATION, PARTEST}
220  ,{"topolynomial", (TFUN)CoToPolynomial, STATEMENT, PARTEST}
221  ,{"tospectator", (TFUN)CoToSpectator, STATEMENT, PARTEST}
222  ,{"totensor", (TFUN)CoToTensor, STATEMENT, PARTEST}
223  ,{"tovector", (TFUN)CoToVector, STATEMENT, PARTEST}
224  ,{"trace4", (TFUN)CoTrace4, STATEMENT, PARTEST}
225  ,{"tracen", (TFUN)CoTraceN, STATEMENT, PARTEST}
226  ,{"transform", (TFUN)CoTransform, STATEMENT, PARTEST}
227  ,{"tryreplace", (TFUN)CoTryReplace, STATEMENT, PARTEST}
228  ,{"unfactorize", (TFUN)CoUnFactorize, TOOUTPUT, PARTEST}
229  ,{"unhide", (TFUN)CoUnHide, SPECIFICATION,PARTEST}
230  ,{"while", (TFUN)CoWhile, STATEMENT, PARTEST}
231 };
232 
233 int alfatable1[27];
234 
235 #define OPTION0 1
236 #define OPTION1 2
237 #define OPTION2 3
238 
239 typedef struct SuBbUf {
240  WORD subexpnum;
241  WORD buffernum;
242 } SUBBUF;
243 
244 SUBBUF *subexpbuffers = 0;
245 SUBBUF *topsubexpbuffers = 0;
246 LONG insubexpbuffers = 0;
247 
248 #define REDUCESUBEXPBUFFERS { if ( (topsubexpbuffers-subexpbuffers) > 256 ) {\
249  M_free(subexpbuffers,"subexpbuffers");\
250  subexpbuffers = (SUBBUF *)Malloc1(256*sizeof(SUBBUF),"subexpbuffers");\
251  topsubexpbuffers = subexpbuffers+256; } insubexpbuffers = 0; }
252 
253 #if defined(ILP32)
254 
255 #define PUTNUMBER128(t,n) { if ( n >= 16384 ) { \
256  *t++ = n/(128*128); *t++ = (n/128)%128; *t++ = n%128; } \
257  else if ( n >= 128 ) { *t++ = n/128; *t++ = n%128; } \
258  else *t++ = n; }
259 #define PUTNUMBER100(t,n) { if ( n >= 10000 ) { \
260  *t++ = n/10000; *t++ = (n/100)%100; *t++ = n%100; } \
261  else if ( n >= 100 ) { *t++ = n/100; *t++ = n%100; } \
262  else *t++ = n; }
263 
264 #elif ( defined(LLP64) || defined(LP64) )
265 
266 #define PUTNUMBER128(t,n) { if ( n >= 2097152 ) { \
267  *t++ = ((n/128)/128)/128; *t++ = ((n/128)/128)%128; *t++ = (n/128)%128; *t++ = n%128; } \
268  else if ( n >= 16384 ) { \
269  *t++ = n/(128*128); *t++ = (n/128)%128; *t++ = n%128; } \
270  else if ( n >= 128 ) { *t++ = n/128; *t++ = n%128; } \
271  else *t++ = n; }
272 #define PUTNUMBER100(t,n) { if ( n >= 1000000 ) { \
273  *t++ = ((n/100)/100)/100; *t++ = ((n/100)/100)%100; *t++ = (n/100)%100; *t++ = n%100; } \
274  else if ( n >= 10000 ) { \
275  *t++ = n/10000; *t++ = (n/100)%100; *t++ = n%100; } \
276  else if ( n >= 100 ) { *t++ = n/100; *t++ = n%100; } \
277  else *t++ = n; }
278 
279 #endif
280 
281 /*
282  )]}
283  #] includes :
284  #[ Compiler :
285  #[ inictable :
286 
287  Routine sets the table for 1-st characters that allow a faster
288  start in the search in table 1 which should be sequential.
289  Search in table 2 can be binary.
290 */
291 
292 VOID inictable()
293 {
294  KEYWORD *k = com1commands;
295  int i, j, ksize;
296  ksize = sizeof(com1commands)/sizeof(KEYWORD);
297  j = 0;
298  alfatable1[0] = 0;
299  for ( i = 0; i < 26; i++ ) {
300  while ( j < ksize && k[j].name[0] == 'a'+i ) j++;
301  alfatable1[i+1] = j;
302  }
303 }
304 
305 /*
306  #] inictable :
307  #[ findcommand :
308 
309  Checks whether a command is in the command table.
310  If so a pointer to the table element is returned.
311  If not we return 0.
312  Note that when a command is not in the table, we have
313  to test whether it is an id command without id. It should
314  then have the structure pattern = rhs. This should be done
315  in the calling routine.
316 */
317 
318 KEYWORD *findcommand(UBYTE *in)
319 {
320  int hi, med, lo, i;
321  UBYTE *s, c;
322  s = in;
323  while ( FG.cTable[*s] <= 1 ) s++;
324  if ( s > in && *s == '[' && s[1] == ']' ) s += 2;
325  if ( *s ) { c = *s; *s = 0; }
326  else c = 0;
327 /*
328  First do a binary search in the second table
329 */
330  lo = 0;
331  hi = sizeof(com2commands)/sizeof(KEYWORD)-1;
332  do {
333  med = ( hi + lo ) / 2;
334  i = StrICmp(in,(UBYTE *)com2commands[med].name);
335  if ( i == 0 ) { if ( c ) *s = c; return(com2commands+med); }
336  if ( i < 0 ) hi = med-1;
337  else lo = med+1;
338  } while ( hi >= lo );
339 /*
340  Now do a 'hashed' search in the first table. It is sequential.
341 */
342  i = tolower(*in) - 'a';
343  med = alfatable1[i];
344  hi = alfatable1[i+1];
345  while ( med < hi ) {
346  if ( StrICont(in,(UBYTE *)com1commands[med].name) == 0 )
347  { if ( c ) *s = c; return(com1commands+med); }
348  med++;
349  }
350  if ( c ) *s = c;
351 /*
352  Unrecognized. Too bad!
353 */
354  return(0);
355 }
356 
357 /*
358  #] findcommand :
359  #[ ParenthesesTest :
360 */
361 
362 int ParenthesesTest(UBYTE *sin)
363 {
364  WORD L1 = 0, L2 = 0, L3 = 0;
365  UBYTE *s = sin;
366  while ( *s ) {
367  if ( *s == '[' ) L1++;
368  else if ( *s == ']' ) {
369  L1--;
370  if ( L1 < 0 ) { MesPrint("&Unmatched []"); return(1); }
371  }
372  s++;
373  }
374  if ( L1 > 0 ) { MesPrint("&Unmatched []"); return(1); }
375  s = sin;
376  while ( *s ) {
377  if ( *s == '[' ) SKIPBRA1(s)
378  else if ( *s == '(' ) { L2++; s++; }
379  else if ( *s == ')' ) {
380  L2--; s++;
381  if ( L2 < 0 ) { MesPrint("&Unmatched ()"); return(1); }
382  }
383  else s++;
384  }
385  if ( L2 > 0 ) { MesPrint("&Unmatched ()"); return(1); }
386  s = sin;
387  while ( *s ) {
388  if ( *s == '[' ) SKIPBRA1(s)
389  else if ( *s == '[' ) SKIPBRA4(s)
390  else if ( *s == '{' ) { L3++; s++; }
391  else if ( *s == '}' ) {
392  L3--; s++;
393  if ( L3 < 0 ) { MesPrint("&Unmatched {}"); return(1); }
394  }
395  else s++;
396  }
397  if ( L3 > 0 ) { MesPrint("&Unmatched {}"); return(1); }
398  return(0);
399 }
400 
401 /*
402  #] ParenthesesTest :
403  #[ SkipAName :
404 
405  Skips a name and gives a pointer to the object after the name.
406  If there is not a proper name, it returns a zero pointer.
407  In principle the brackets match already, so the `if ( *s == 0 )'
408  code is not really needed, but you never know how the program
409  is extended later.
410 */
411 
412 UBYTE *SkipAName(UBYTE *s)
413 {
414  UBYTE *t = s;
415  if ( *s == '[' ) {
416  SKIPBRA1(s)
417  if ( *s == 0 ) {
418  MesPrint("&Illegal name: '%s'",t);
419  return(0);
420  }
421  s++;
422  }
423  else if ( FG.cTable[*s] == 0 || *s == '_' || *s == '$' ) {
424  if ( *s == '$' ) s++;
425  while ( FG.cTable[*s] <= 1 ) s++;
426  if ( *s == '_' ) s++;
427  }
428  else {
429  MesPrint("&Illegal name: '%s'",t);
430  return(0);
431  }
432  return(s);
433 }
434 
435 /*
436  #] SkipAName :
437  #[ IsRHS :
438 */
439 
440 UBYTE *IsRHS(UBYTE *s, UBYTE c)
441 {
442  while ( *s && *s != c ) {
443  if ( *s == '[' ) {
444  SKIPBRA1(s);
445  if ( *s != ']' ) {
446  MesPrint("&Unmatched []");
447  return(0);
448  }
449  }
450  else if ( *s == '{' ) {
451  SKIPBRA2(s);
452  if ( *s != '}' ) {
453  MesPrint("&Unmatched {}");
454  return(0);
455  }
456  }
457  else if ( *s == '(' ) {
458  SKIPBRA3(s);
459  if ( *s != ')' ) {
460  MesPrint("&Unmatched ()");
461  return(0);
462  }
463  }
464  else if ( *s == ')' ) {
465  MesPrint("&Unmatched ()");
466  return(0);
467  }
468  else if ( *s == '}' ) {
469  MesPrint("&Unmatched {}");
470  return(0);
471  }
472  else if ( *s == ']' ) {
473  MesPrint("&Unmatched []");
474  return(0);
475  }
476  s++;
477  }
478  return(s);
479 }
480 
481 /*
482  #] IsRHS :
483  #[ IsIdStatement :
484 */
485 
486 int IsIdStatement(UBYTE *s)
487 {
488  DUMMYUSE(s);
489  return(0);
490 }
491 
492 /*
493  #] IsIdStatement :
494  #[ CompileAlgebra :
495 
496  Returns either the number of the main level RHS (>= 0)
497  or an error code (< 0)
498 */
499 
500 int CompileAlgebra(UBYTE *s, int leftright, WORD *prototype)
501 {
502  GETIDENTITY
503  int error;
504  WORD *oldproto = AC.ProtoType;
505  AC.ProtoType = prototype;
506  if ( AC.TokensWriteFlag ) {
507  MesPrint("To tokenize: %s",s);
508  error = tokenize(s,leftright);
509  MesPrint(" The contents of the token buffer are:");
510  WriteTokens(AC.tokens);
511  }
512  else error = tokenize(s,leftright);
513  if ( error == 0 ) {
514  AR.Eside = leftright;
515  AC.CompileLevel = 0;
516  if ( leftright == LHSIDE ) { AC.DumNum = AR.CurDum = 0; }
517  error = CompileSubExpressions(AC.tokens);
518  REDUCESUBEXPBUFFERS
519  }
520  else {
521  AC.ProtoType = oldproto;
522  return(-1);
523  }
524  AC.ProtoType = oldproto;
525  if ( error < 0 ) return(-1);
526  else if ( leftright == LHSIDE ) return(cbuf[AC.cbufnum].numlhs);
527  else return(cbuf[AC.cbufnum].numrhs);
528 }
529 
530 /*
531  #] CompileAlgebra :
532  #[ CompileStatement :
533 
534 */
535 
536 int CompileStatement(UBYTE *in)
537 {
538  KEYWORD *k;
539  UBYTE *s;
540  int error1 = 0, error2;
541  /* A.iStatement = */ s = in;
542  if ( *s == 0 ) return(0);
543  if ( *s == '$' ) {
544  k = findcommand((UBYTE *)"assign");
545  }
546  else {
547  if ( ( k = findcommand(s) ) == 0 && IsIdStatement(s) == 0 ) {
548  MesPrint("&Unrecognized statement");
549  return(1);
550  }
551  if ( k == 0 ) { /* Id statement without id. Note: id must be in table */
552  k = com1commands + alfatable1['i'-'a'];
553  while ( k->name[1] != 'd' || k->name[2] ) k++;
554  }
555  else {
556  while ( FG.cTable[*s] <= 1 ) s++;
557  if ( s > in && *s == '[' && s[1] == ']' ) s += 2;
558 /*
559  The next statement is rather mysterious
560  It is undone in DoPrint and CoMultiply, but it also causes effects
561  in other (wrong) statements like dimension -4; or Trace4 -1;
562  The code in pre.c (LoadStatement) has been changed 8-sep-2009
563  to force a comma after the keyword. This means that the
564  'mysterious' line is automatically inactive. Hence it is taken out.
565 
566  if ( *s == '+' || *s == '-' ) s++;
567 */
568  if ( *s == ',' ) s++;
569  }
570  }
571 /*
572  First the test on the order of the statements.
573  This is relatively new (2.2c) and may cause some problems with old
574  programs. Hence the first error message should explain!
575 */
576  if ( AP.PreAssignFlag == 0 && AM.OldOrderFlag == 0 ) {
577  if ( AP.PreInsideLevel ) {
578  if ( k->type != STATEMENT && k->type != MIXED ) {
579  MesPrint("&Only executable and print statements are allowed in an %#inside/%#endinside construction");
580  return(-1);
581  }
582  }
583  else {
584  if ( ( AC.compiletype == DECLARATION || AC.compiletype == SPECIFICATION )
585  && ( k->type == STATEMENT || k->type == DEFINITION || k->type == TOOUTPUT ) ) {
586  if ( AC.tablecheck == 0 ) {
587  AC.tablecheck = 1;
588  if ( TestTables() ) error1 = 1;
589  }
590  }
591  if ( k->type == MIXED ) {
592  if ( AC.compiletype <= DEFINITION ) {
593  AC.compiletype = STATEMENT;
594  }
595  }
596  else if ( k->type > AC.compiletype ) {
597  if ( StrCmp((UBYTE *)(k->name),(UBYTE *)"format") != 0 )
598  AC.compiletype = k->type;
599  }
600  else if ( k->type < AC.compiletype ) {
601  switch ( k->type ) {
602  case DECLARATION:
603  MesPrint("&Declaration out of order");
604  MesPrint("& %s",in);
605  break;
606  case DEFINITION:
607  MesPrint("&Definition out of order");
608  MesPrint("& %s",in);
609  break;
610  case SPECIFICATION:
611  MesPrint("&Specification out of order");
612  MesPrint("& %s",in);
613  break;
614  case STATEMENT:
615  MesPrint("&Statement out of order");
616  break;
617  case TOOUTPUT:
618  MesPrint("&Output control statement out of order");
619  MesPrint("& %s",in);
620  break;
621  }
622  AC.compiletype = k->type;
623  if ( AC.firstctypemessage == 0 ) {
624  MesPrint("&Proper order inside a module is:");
625  MesPrint("Declarations, specifications, definitions, statements, output control statements");
626  AC.firstctypemessage = 1;
627  }
628  error1 = 1;
629  }
630  }
631  }
632 /*
633  Now we execute the tests that are prescribed by the flags.
634 */
635  if ( AC.AutoDeclareFlag && ( ( k->flags & WITHAUTO ) == 0 ) ) {
636  MesPrint("&Illegal type of auto-declaration");
637  return(1);
638  }
639  if ( ( ( k->flags & PARTEST ) != 0 ) && ParenthesesTest(s) ) return(1);
640  error2 = (*k->func)(s);
641  if ( error2 == 0 ) return(error1);
642  return(error2);
643 }
644 
645 /*
646  #] CompileStatement :
647  #[ TestTables :
648 */
649 
650 int TestTables()
651 {
652  FUNCTIONS f = functions;
653  TABLES t;
654  WORD j;
655  int error = 0, i;
656  LONG x;
657  i = NumFunctions + FUNCTION - MAXBUILTINFUNCTION - 1;
658  f = f + MAXBUILTINFUNCTION - FUNCTION + 1;
659  if ( AC.MustTestTable > 0 ) {
660  while ( i > 0 ) {
661  if ( ( t = f->tabl ) != 0 && t->strict > 0 && !t->sparse ) {
662  for ( x = 0, j = 0; x < t->totind; x++ ) {
663  if ( t->tablepointers[TABLEEXTENSION*x] < 0 ) j++;
664  }
665  if ( j > 0 ) {
666  if ( j > 1 ) {
667  MesPrint("&In table %s there are %d unfilled elements",
668  AC.varnames->namebuffer+f->name,j);
669  }
670  else {
671  MesPrint("&In table %s there is one unfilled element",
672  AC.varnames->namebuffer+f->name);
673  }
674  error = 1;
675  }
676  }
677  i--; f++;
678  }
679  AC.MustTestTable--;
680  }
681  return(error);
682 }
683 
684 /*
685  #] TestTables :
686  #[ CompileSubExpressions :
687 
688  Now we attack the subexpressions from inside out.
689  We try to see whether we had any of them already.
690  We have to worry about adding the wildcard sum parameter
691  to the prototype.
692 */
693 
694 int CompileSubExpressions(SBYTE *tokens)
695 {
696  GETIDENTITY
697  SBYTE *fill = tokens, *s = tokens, *t;
698  WORD number[MAXNUMSIZE], *oldwork, *w1, *w2;
699  int level, num, i, sumlevel = 0, sumtype = SYMTOSYM;
700  int retval, error = 0;
701 /*
702  Eliminate all subexpressions. They are marked by LPARENTHESIS,RPARENTHESIS
703 */
704  AC.CompileLevel++;
705  while ( *s != TENDOFIT ) {
706  if ( *s == TFUNOPEN ) {
707  if ( fill < s ) *fill = TENDOFIT;
708  t = fill - 1;
709  while ( t >= tokens && t[0] >= 0 ) t--;
710  if ( t >= tokens && *t == TFUNCTION ) {
711  t++; i = 0; while ( *t >= 0 ) i = 128*i + *t++;
712  if ( i == AM.sumnum || i == AM.sumpnum ) {
713  t = s + 1;
714  if ( *t == TSYMBOL || *t == TINDEX ) {
715  t++; i = 0; while ( *t >= 0 ) i = 128*i + *t++;
716  if ( s[1] == TINDEX ) {
717  i += AM.OffsetIndex;
718  sumtype = INDTOIND;
719  }
720  else sumtype = SYMTOSYM;
721  sumlevel = i;
722  }
723  }
724  }
725  *fill++ = *s++;
726  }
727  else if ( *s == TFUNCLOSE ) { sumlevel = 0; *fill++ = *s++; }
728  else if ( *s == LPARENTHESIS ) {
729 /*
730  We must make an exception here.
731  If the subexpression is just an integer, whatever its length,
732  we should try to keep it.
733  This is important when we have a function with an integer
734  argument. In particular this is relevant for the MZV program.
735 */
736  t = s; level = 0;
737  while ( level >= 0 ) {
738  s++;
739  if ( *s == LPARENTHESIS ) level++;
740  else if ( *s == RPARENTHESIS ) level--;
741  else if ( *s == TENDOFIT ) {
742  MesPrint("&Unbalanced subexpression parentheses");
743  return(-1);
744  }
745  }
746  t++; *s = TENDOFIT;
747  if ( sumlevel > 0 ) { /* Inside sum. Add wildcard to prototype */
748  oldwork = w1 = AT.WorkPointer;
749  w2 = AC.ProtoType;
750  i = w2[1];
751  while ( --i >= 0 ) *w1++ = *w2++;
752  oldwork[1] += 4;
753  *w1++ = sumtype; *w1++ = 4; *w1++ = sumlevel; *w1++ = sumlevel;
754  w2 = AC.ProtoType; AT.WorkPointer = w1;
755  AC.ProtoType = oldwork;
756  num = CompileSubExpressions(t);
757  AC.ProtoType = w2; AT.WorkPointer = oldwork;
758  }
759  else num = CompileSubExpressions(t);
760  if ( num < 0 ) return(-1);
761 /*
762  Note that the subexpression code should always fit.
763  We had two parentheses and at least two bytes contents.
764  There cannot be more than 2^21 subexpressions or we get outside
765  this minimum. Ignoring this might lead to really rare and
766  hard to find errors, years from now.
767 */
768  if ( insubexpbuffers >= MAXSUBEXPRESSIONS ) {
769  MesPrint("&More than %d subexpressions inside one expression",(WORD)MAXSUBEXPRESSIONS);
770  Terminate(-1);
771  }
772  if ( subexpbuffers+insubexpbuffers >= topsubexpbuffers ) {
773  DoubleBuffer((void **)((VOID *)(&subexpbuffers))
774  ,(void **)((VOID *)(&topsubexpbuffers)),sizeof(SUBBUF),"subexpbuffers");
775  }
776  subexpbuffers[insubexpbuffers].subexpnum = num;
777  subexpbuffers[insubexpbuffers].buffernum = AC.cbufnum;
778  num = insubexpbuffers++;
779  *fill++ = TSUBEXP;
780  i = 0;
781  do { number[i++] = num & 0x7F; num >>= 7; } while ( num );
782  while ( --i >= 0 ) *fill++ = (SBYTE)(number[i]);
783  s++;
784  }
785  else if ( *s == TEMPTY ) s++;
786  else *fill++ = *s++;
787  }
788  *fill = TENDOFIT;
789 /*
790  At this stage there are no more subexpressions.
791  Hence we can do the basic compilation.
792 */
793  if ( AC.CompileLevel == 1 && AC.ToBeInFactors ) {
794  error = CodeFactors(tokens);
795  }
796  AC.CompileLevel--;
797  retval = CodeGenerator(tokens);
798  if ( error < 0 ) return(error);
799  return(retval);
800 }
801 
802 /*
803  #] CompileSubExpressions :
804  #[ CodeGenerator :
805 
806  This routine does the real code generation.
807  It returns the number of the rhs subexpression.
808  At this point we do not have to worry about subexpressions,
809  sets, setelements, simple vs complicated function arguments
810  simple vs complicated powers etc.
811 
812  The variable 'first' indicates whether we are starting a new term
813 
814  The major complication are the set elements of type set[n].
815  We have marked them as TSETNUM,n,Ttype,setnum
816  They go into
817  SETSET,size,subterm,relocation list
818  in which the subterm should be ready to become a regular
819  subterm in which the sets have been replaced by their element
820  The relocation list consists of pairs of numbers:
821  1: offset in the subterm, 2: the symbol n.
822  Note that such a subterm can be a whole function with its arguments.
823  We use the variable inset to indicate that we have something going.
824  The relocation list is collected in the top of the WorkSpace.
825 */
826 
827 static UWORD *CGscrat7 = 0;
828 
829 int CodeGenerator(SBYTE *tokens)
830 {
831  GETIDENTITY
832  SBYTE *s = tokens, c;
833  int i, sign = 1, first = 1, deno = 1, error = 0, minus, n, needarg, numexp, cc;
834  int base, sumlevel = 0, sumtype = SYMTOSYM, firstsumarg, inset = 0;
835  int funflag = 0, settype, x1, x2, mulflag = 0;
836  WORD *t, *v, *r, *term, nnumerator, ndenominator, *oldwork, x3, y, nin;
837  WORD *w1, *w2, *tsize = 0, *relo = 0;
838  UWORD *numerator, *denominator, *innum;
839  CBUF *C;
840  POSITION position;
841  WORD TMproto[SUBEXPSIZE];
842 /*
843 #ifdef WITHPTHREADS
844  RENUMBER renumber;
845 #endif
846 */
847  RENUMBER renumber;
848  if ( AC.TokensWriteFlag ) WriteTokens(tokens);
849  if ( CGscrat7 == 0 )
850  CGscrat7 = (UWORD *)Malloc1((AM.MaxTal+2)*sizeof(WORD),"CodeGenerator");
851  AddRHS(AC.cbufnum,0);
852  C = cbuf + AC.cbufnum;
853  numexp = C->numrhs;
854  C->NumTerms[numexp] = 0;
855  C->numdum[numexp] = 0;
856  oldwork = AT.WorkPointer;
857  numerator = (UWORD *)(AT.WorkPointer);
858  denominator = numerator + 2*AM.MaxTal;
859  innum = denominator + 2*AM.MaxTal;
860  term = (WORD *)(innum + 2*AM.MaxTal);
861  AT.WorkPointer = term + AM.MaxTer/sizeof(WORD);
862  if ( AT.WorkPointer > AT.WorkTop ) goto OverWork;
863  cc = 0;
864  t = term+1;
865  numerator[0] = denominator[0] = 1;
866  nnumerator = ndenominator = 1;
867  while ( *s != TENDOFIT ) {
868  if ( *s == TPLUS || *s == TMINUS ) {
869  if ( first || mulflag ) { if ( *s == TMINUS ) sign = -sign; }
870  else {
871  *term = t-term;
872  C->NumTerms[numexp]++;
873  if ( cc && sign ) C->CanCommu[numexp]++;
874  CompleteTerm(term,numerator,denominator,nnumerator,ndenominator,sign);
875  first = 1; cc = 0; t = term + 1; deno = 1;
876  numerator[0] = denominator[0] = 1;
877  nnumerator = ndenominator = 1;
878  if ( *s == TMINUS ) sign = -1;
879  else sign = 1;
880  }
881  s++;
882  }
883  else {
884  mulflag = first = 0; c = *s++;
885  switch ( c ) {
886  case TSYMBOL:
887  x1 = 0; while ( *s >= 0 ) { x1 = x1*128 + *s++; }
888  if ( *s == TWILDCARD ) { s++; x1 += 2*MAXPOWER; }
889  *t++ = SYMBOL; *t++ = 4; *t++ = x1;
890  if ( inset ) *relo = 2;
891 TryPower: if ( *s == TPOWER ) {
892  s++;
893  if ( *s == TMINUS ) { s++; deno = -deno; }
894  c = *s++;
895  base = ( c == TNUMBER ) ? 100: 128;
896  x2 = 0; while ( *s >= 0 ) { x2 = base*x2 + *s++; }
897  if ( c == TSYMBOL ) {
898  if ( *s == TWILDCARD ) s++;
899  x2 += 2*MAXPOWER;
900  }
901  *t++ = deno*x2;
902  }
903  else *t++ = deno;
904 fin: deno = 1;
905  if ( inset ) {
906  while ( relo < AT.WorkTop ) *t++ = *relo++;
907  inset = 0; tsize[1] = t - tsize;
908  }
909  break;
910  case TINDEX:
911  x1 = 0; while ( *s >= 0 ) { x1 = x1*128 + *s++; }
912  *t++ = INDEX; *t++ = 3;
913  if ( *s == TWILDCARD ) { s++; x1 += WILDOFFSET; }
914  if ( inset ) { *t++ = x1; *relo = 2; }
915  else *t++ = x1 + AM.OffsetIndex;
916  if ( t[-1] > AM.IndDum ) {
917  x1 = t[-1] - AM.IndDum;
918  if ( x1 > C->numdum[numexp] ) C->numdum[numexp] = x1;
919  }
920  goto fin;
921  case TGENINDEX:
922  *t++ = INDEX; *t++ = 3; *t++ = AC.DumNum+WILDOFFSET;
923  deno = 1;
924  break;
925  case TVECTOR:
926  x1 = 0; while ( *s >= 0 ) { x1 = x1*128 + *s++; }
927 dovector: if ( inset == 0 ) x1 += AM.OffsetVector;
928  if ( *s == TWILDCARD ) { s++; x1 += WILDOFFSET; }
929  if ( inset ) *relo = 2;
930  if ( *s == TDOT ) { /* DotProduct ? */
931  s++;
932  if ( *s == TSETNUM || *s == TSETDOL ) {
933  settype = ( *s == TSETDOL );
934  s++; x2 = 0; while ( *s >= 0 ) { x2 = x2*128 + *s++; }
935  if ( settype ) x2 = -x2;
936  if ( inset == 0 ) {
937  tsize = t; *t++ = SETSET; *t++ = 0;
938  relo = AT.WorkTop;
939  }
940  inset += 2;
941  *--relo = x2; *--relo = 3;
942  }
943  if ( *s != TVECTOR && *s != TDUBIOUS ) {
944  MesPrint("&Illegally formed dotproduct");
945  error = 1;
946  }
947  s++; x2 = 0; while ( *s >= 0 ) { x2 = x2*128 + *s++; }
948  if ( inset < 2 ) x2 += AM.OffsetVector;
949  if ( *s == TWILDCARD ) { s++; x2 += WILDOFFSET; }
950  *t++ = DOTPRODUCT; *t++ = 5; *t++ = x1; *t++ = x2;
951  goto TryPower;
952  }
953  else if ( *s == TFUNOPEN ) {
954  s++;
955  if ( *s == TSETNUM || *s == TSETDOL ) {
956  settype = ( *s == TSETDOL );
957  s++; x2 = 0; while ( *s >= 0 ) { x2 = x2*128 + *s++; }
958  if ( settype ) x2 = -x2;
959  if ( inset == 0 ) {
960  tsize = t; *t++ = SETSET; *t++ = 0;
961  relo = AT.WorkTop;
962  }
963  inset += 2;
964  *--relo = x2; *--relo = 3;
965  }
966  if ( *s == TINDEX || *s == TDUBIOUS ) {
967  s++;
968  x2 = 0; while ( *s >= 0 ) { x2 = x2*128 + *s++; }
969  if ( inset < 2 ) x2 += AM.OffsetIndex;
970  if ( *s == TWILDCARD ) { s++; x2 += WILDOFFSET; }
971  *t++ = VECTOR; *t++ = 4; *t++ = x1; *t++ = x2;
972  if ( t[-1] > AM.IndDum ) {
973  x2 = t[-1] - AM.IndDum;
974  if ( x2 > C->numdum[numexp] ) C->numdum[numexp] = x2;
975  }
976  }
977  else if ( *s == TGENINDEX ) {
978  *t++ = VECTOR; *t++ = 4; *t++ = x1;
979  *t++ = AC.DumNum + WILDOFFSET;
980  }
981  else if ( *s == TNUMBER || *s == TNUMBER1 ) {
982  base = ( *s == TNUMBER ) ? 100: 128;
983  s++;
984  x2 = 0; while ( *s >= 0 ) { x2 = x2*base + *s++; }
985  if ( x2 >= AM.OffsetIndex && inset < 2 ) {
986  MesPrint("&Fixed index in vector greater than %d",
987  AM.OffsetIndex);
988  return(-1);
989  }
990  *t++ = VECTOR; *t++ = 4; *t++ = x1; *t++ = x2;
991  }
992  else if ( *s == TVECTOR || ( *s == TMINUS && s[1] == TVECTOR ) ) {
993  if ( *s == TMINUS ) { s++; sign = -sign; }
994  s++;
995  x2 = 0; while ( *s >= 0 ) { x2 = x2*128 + *s++; }
996  if ( inset < 2 ) x2 += AM.OffsetVector;
997  if ( *s == TWILDCARD ) { s++; x2 += WILDOFFSET; }
998  *t++ = DOTPRODUCT; *t++ = 5; *t++ = x1; *t++ = x2; *t++ = deno;
999  }
1000  else {
1001  MesPrint("&Illegal argument for vector");
1002  return(-1);
1003  }
1004  if ( *s != TFUNCLOSE ) {
1005  MesPrint("&Illegal argument for vector");
1006  return(-1);
1007  }
1008  s++;
1009  }
1010  else {
1011  if ( AC.DumNum ) {
1012  *t++ = VECTOR; *t++ = 4; *t++ = x1;
1013  *t++ = AC.DumNum + WILDOFFSET;
1014  }
1015  else {
1016  *t++ = INDEX; *t++ = 3; *t++ = x1;
1017  }
1018  }
1019  goto fin;
1020  case TDELTA:
1021  if ( *s != TFUNOPEN ) {
1022  MesPrint("&d_ needs two arguments");
1023  error = -1;
1024  }
1025  v = t; *t++ = DELTA; *t++ = 4;
1026  needarg = 2; x3 = x1 = -1;
1027  goto dotensor;
1028  case TFUNCTION:
1029  x1 = 0; while ( *s >= 0 ) { x1 = x1*128 + *s++; }
1030  if ( x1 == AM.sumnum || x1 == AM.sumpnum ) sumlevel = x1;
1031  x1 += FUNCTION;
1032  if ( x1 == FIRSTBRACKET ) {
1033  if ( s[0] == TFUNOPEN && s[1] == TEXPRESSION ) {
1034 doexpr: s += 2;
1035  *t++ = x1; *t++ = FUNHEAD+2; *t++ = 0;
1036  if ( x1 == AR.PolyFun && AR.PolyFunType == 2 && AR.Eside != LHSIDE )
1037  t[-1] |= MUSTCLEANPRF;
1038  FILLFUN3(t)
1039  x2 = 0; while ( *s >= 0 ) { x2 = x2*128 + *s++; }
1040  *t++ = -EXPRESSION; *t++ = x2;
1041 /*
1042  The next code is added to facilitate parallel processing
1043  We need to call GetTable here to make sure all processors
1044  have the same numbering of all variables.
1045 */
1046  if ( Expressions[x2].status == STOREDEXPRESSION ) {
1047  TMproto[0] = EXPRESSION;
1048  TMproto[1] = SUBEXPSIZE;
1049  TMproto[2] = x2;
1050  TMproto[3] = 1;
1051  { int ie; for ( ie = 4; ie < SUBEXPSIZE; ie++ ) TMproto[ie] = 0; }
1052  AT.TMaddr = TMproto;
1053  PUTZERO(position);
1054 /*
1055  if ( (
1056 #ifdef WITHPTHREADS
1057  renumber =
1058 #endif
1059  GetTable(x2,&position,0) ) == 0 ) {
1060  error = 1;
1061  MesPrint("&Problems getting information about stored expression %s(1)"
1062  ,EXPRNAME(x2));
1063  }
1064 #ifdef WITHPTHREADS
1065  M_free(renumber->symb.lo,"VarSpace");
1066  M_free(renumber,"Renumber");
1067 #endif
1068 */
1069  if ( ( renumber = GetTable(x2,&position,0) ) == 0 ) {
1070  error = 1;
1071  MesPrint("&Problems getting information about stored expression %s(1)"
1072  ,EXPRNAME(x2));
1073  }
1074  if ( renumber->symb.lo != AN.dummyrenumlist )
1075  M_free(renumber->symb.lo,"VarSpace");
1076  M_free(renumber,"Renumber");
1077  AR.StoreData.dirtyflag = 1;
1078  }
1079  if ( *s != TFUNCLOSE ) {
1080  if ( x1 == FIRSTBRACKET )
1081  MesPrint("&Problems with argument of FirstBracket_");
1082  else if ( x1 == FIRSTTERM )
1083  MesPrint("&Problems with argument of FirstTerm_");
1084  else if ( x1 == CONTENTTERM )
1085  MesPrint("&Problems with argument of FirstTerm_");
1086  else if ( x1 == TERMSINEXPR )
1087  MesPrint("&Problems with argument of TermsIn_");
1088  else if ( x1 == SIZEOFFUNCTION )
1089  MesPrint("&Problems with argument of SizeOf_");
1090  else if ( x1 == NUMFACTORS )
1091  MesPrint("&Problems with argument of NumFactors_");
1092  else
1093  MesPrint("&Problems with argument of FactorIn_");
1094  error = 1;
1095  while ( *s != TENDOFIT && *s != TFUNCLOSE ) s++;
1096  }
1097  if ( *s == TFUNCLOSE ) s++;
1098  goto fin;
1099  }
1100  }
1101  else if ( x1 == TERMSINEXPR || x1 == SIZEOFFUNCTION || x1 == FACTORIN
1102  || x1 == NUMFACTORS || x1 == FIRSTTERM || x1 == CONTENTTERM ) {
1103  if ( s[0] == TFUNOPEN && s[1] == TEXPRESSION ) goto doexpr;
1104  if ( s[0] == TFUNOPEN && s[1] == TDOLLAR ) {
1105  s += 2;
1106  *t++ = x1; *t++ = FUNHEAD+2; *t++ = 0;
1107  FILLFUN3(t)
1108  x2 = 0; while ( *s >= 0 ) { x2 = x2*128 + *s++; }
1109  *t++ = -DOLLAREXPRESSION; *t++ = x2;
1110  if ( *s != TFUNCLOSE ) {
1111  if ( x1 == TERMSINEXPR )
1112  MesPrint("&Problems with argument of TermsIn_");
1113  else if ( x1 == SIZEOFFUNCTION )
1114  MesPrint("&Problems with argument of SizeOf_");
1115  else if ( x1 == NUMFACTORS )
1116  MesPrint("&Problems with argument of NumFactors_");
1117  else
1118  MesPrint("&Problems with argument of FactorIn_");
1119  error = 1;
1120  while ( *s != TENDOFIT && *s != TFUNCLOSE ) s++;
1121  }
1122  if ( *s == TFUNCLOSE ) s++;
1123  goto fin;
1124  }
1125  }
1126  x3 = x1;
1127  if ( inset && ( t-tsize == 2 ) ) x1 -= FUNCTION;
1128  if ( *s == TWILDCARD ) { x1 += WILDOFFSET; s++; }
1129  if ( functions[x3-FUNCTION].commute ) cc = 1;
1130  if ( *s != TFUNOPEN ) {
1131  *t++ = x1; *t++ = FUNHEAD; *t++ = 0;
1132  if ( x1 == AR.PolyFun && AR.PolyFunType == 2 && AR.Eside != LHSIDE )
1133  t[-1] |= MUSTCLEANPRF;
1134  FILLFUN3(t) sumlevel = 0; goto fin;
1135  }
1136  v = t; *t++ = x1; *t++ = FUNHEAD; *t++ = DIRTYFLAG;
1137  if ( x1 == AR.PolyFun && AR.PolyFunType == 2 && AR.Eside != LHSIDE )
1138  t[-1] |= MUSTCLEANPRF;
1139  FILLFUN3(t)
1140  needarg = -1;
1141  if ( !inset && functions[x3-FUNCTION].spec >= TENSORFUNCTION ) {
1142 dotensor:
1143  do {
1144  if ( needarg == 0 ) {
1145  if ( x1 >= 0 ) {
1146  x3 = x1;
1147  if ( x3 >= FUNCTION+WILDOFFSET ) x3 -= WILDOFFSET;
1148  MesPrint("&Too many arguments in function %s",
1149  VARNAME(functions,(x3-FUNCTION)) );
1150  }
1151  else
1152  MesPrint("&d_ needs exactly two arguments");
1153  error = -1;
1154  needarg--;
1155  }
1156  else if ( needarg > 0 ) needarg--;
1157  s++;
1158  c = *s++;
1159  if ( c == TMINUS && *s == TVECTOR ) { sign = -sign; c = *s++; }
1160  base = ( c == TNUMBER ) ? 100: 128;
1161  x2 = 0; while ( *s >= 0 ) { x2 = base*x2 + *s++; }
1162  if ( *s == TWILDCARD && c != TNUMBER ) { x2 += WILDOFFSET; s++; }
1163  if ( c == TSETNUM || c == TSETDOL ) {
1164  if ( c == TSETDOL ) x2 = -x2;
1165  if ( inset == 0 ) {
1166  w1 = t; t += 2; w2 = t;
1167  while ( w1 > v ) *--w2 = *--w1;
1168  tsize = v; relo = AT.WorkTop;
1169  *v++ = SETSET; *v++ = 0;
1170  }
1171  inset = 2; *--relo = x2; *--relo = t - v;
1172  c = *s++;
1173  x2 = 0; while ( *s >= 0 ) x2 = 128*x2 + *s++;
1174  switch ( c ) {
1175  case TINDEX:
1176  *t++ = x2;
1177  if ( t[-1]+AM.OffsetIndex > AM.IndDum ) {
1178  x2 = t[-1]+AM.OffsetIndex - AM.IndDum;
1179  if ( x2 > C->numdum[numexp] ) C->numdum[numexp] = x2;
1180  }
1181  break;
1182  case TVECTOR:
1183  *t++ = x2; break;
1184  case TNUMBER1:
1185  if ( x2 >= 0 && x2 < AM.OffsetIndex ) {
1186  *t++ = x2; break;
1187  }
1188  /* fall through */
1189  default:
1190  MesPrint("&Illegal type of set inside tensor");
1191  error = 1;
1192  *t++ = x2;
1193  break;
1194  }
1195  }
1196  else { switch ( c ) {
1197  case TINDEX:
1198  if ( inset < 2 ) *t++ = x2 + AM.OffsetIndex;
1199  else *t++ = x2;
1200  if ( x2+AM.OffsetIndex > AM.IndDum ) {
1201  x2 = x2+AM.OffsetIndex - AM.IndDum;
1202  if ( x2 > C->numdum[numexp] ) C->numdum[numexp] = x2;
1203  }
1204  break;
1205  case TGENINDEX:
1206  *t++ = AC.DumNum + WILDOFFSET;
1207  break;
1208  case TVECTOR:
1209  if ( inset < 2 ) *t++ = x2 + AM.OffsetVector;
1210  else *t++ = x2;
1211  break;
1212  case TWILDARG:
1213  *t++ = FUNNYWILD; *t++ = x2;
1214 /* v[2] = 0; */
1215  break;
1216  case TDOLLAR:
1217  *t++ = FUNNYDOLLAR; *t++ = x2;
1218  break;
1219  case TDUBIOUS:
1220  if ( inset < 2 ) *t++ = x2 + AM.OffsetVector;
1221  else *t++ = x2;
1222  break;
1223  case TSGAMMA: /* Special gamma's */
1224  if ( x3 != GAMMA ) {
1225  MesPrint("&5_,6_,7_ can only be used inside g_");
1226  error = -1;
1227  }
1228  *t++ = -x2;
1229  break;
1230  case TNUMBER:
1231  case TNUMBER1:
1232  if ( x2 >= AM.OffsetIndex && inset < 2 ) {
1233  MesPrint("&Value of constant index in tensor too large");
1234  error = -1;
1235  }
1236  *t++ = x2;
1237  break;
1238  default:
1239  MesPrint("&Illegal object in tensor");
1240  error = -1;
1241  break;
1242  }}
1243  if ( inset >= 2 ) inset = 1;
1244  } while ( *s == TCOMMA );
1245  }
1246  else {
1247 dofunction: firstsumarg = 1;
1248  do {
1249  unsigned int ux2;
1250  s++;
1251  c = *s++;
1252  if ( c == TMINUS && ( *s == TVECTOR || *s == TNUMBER
1253  || *s == TNUMBER1 || *s == TSUBEXP ) ) {
1254  minus = 1; c = *s++;
1255  }
1256  else minus = 0;
1257  base = ( c == TNUMBER ) ? 100: 128;
1258  ux2 = 0; while ( *s >= 0 ) { ux2 = base*ux2 + *s++; }
1259  x2 = ux2; /* may cause an implementation-defined behaviour */
1260 /*
1261  !!!!!!!! What if it does not fit?
1262 */
1263  if ( firstsumarg ) {
1264  firstsumarg = 0;
1265  if ( sumlevel > 0 ) {
1266  if ( c == TSYMBOL ) {
1267  sumlevel = x2; sumtype = SYMTOSYM;
1268  }
1269  else if ( c == TINDEX ) {
1270  sumlevel = x2+AM.OffsetIndex; sumtype = INDTOIND;
1271  if ( sumlevel > AM.IndDum ) {
1272  x2 = sumlevel - AM.IndDum;
1273  if ( x2 > C->numdum[numexp] ) C->numdum[numexp] = x2;
1274  }
1275  }
1276  }
1277  }
1278  if ( *s == TWILDCARD ) {
1279  if ( c == TSYMBOL ) x2 += 2*MAXPOWER;
1280  else if ( c != TNUMBER ) x2 += WILDOFFSET;
1281  s++;
1282  }
1283  switch ( c ) {
1284  case TSYMBOL:
1285  *t++ = -SYMBOL; *t++ = x2; break;
1286  case TDOLLAR:
1287  *t++ = -DOLLAREXPRESSION; *t++ = x2; break;
1288  case TEXPRESSION:
1289  *t++ = -EXPRESSION; *t++ = x2;
1290 /*
1291  The next code is added to facilitate parallel processing
1292  We need to call GetTable here to make sure all processors
1293  have the same numbering of all variables.
1294 */
1295  if ( Expressions[x2].status == STOREDEXPRESSION ) {
1296  TMproto[0] = EXPRESSION;
1297  TMproto[1] = SUBEXPSIZE;
1298  TMproto[2] = x2;
1299  TMproto[3] = 1;
1300  { int ie; for ( ie = 4; ie < SUBEXPSIZE; ie++ ) TMproto[ie] = 0; }
1301  AT.TMaddr = TMproto;
1302  PUTZERO(position);
1303 /*
1304  if ( (
1305 #ifdef WITHPTHREADS
1306  renumber =
1307 #endif
1308  GetTable(x2,&position,0) ) == 0 ) {
1309  error = 1;
1310  MesPrint("&Problems getting information about stored expression %s(2)"
1311  ,EXPRNAME(x2));
1312  }
1313 #ifdef WITHPTHREADS
1314  M_free(renumber->symb.lo,"VarSpace");
1315  M_free(renumber,"Renumber");
1316 #endif
1317 */
1318  if ( ( renumber = GetTable(x2,&position,0) ) == 0 ) {
1319  error = 1;
1320  MesPrint("&Problems getting information about stored expression %s(2)"
1321  ,EXPRNAME(x2));
1322  }
1323  if ( renumber->symb.lo != AN.dummyrenumlist )
1324  M_free(renumber->symb.lo,"VarSpace");
1325  M_free(renumber,"Renumber");
1326  AR.StoreData.dirtyflag = 1;
1327  }
1328  break;
1329  case TINDEX:
1330  *t++ = -INDEX; *t++ = x2 + AM.OffsetIndex;
1331  if ( t[-1] > AM.IndDum ) {
1332  x2 = t[-1] - AM.IndDum;
1333  if ( x2 > C->numdum[numexp] ) C->numdum[numexp] = x2;
1334  }
1335  break;
1336  case TGENINDEX:
1337  *t++ = -INDEX; *t++ = AC.DumNum + WILDOFFSET;
1338  break;
1339  case TVECTOR:
1340  if ( minus ) *t++ = -MINVECTOR;
1341  else *t++ = -VECTOR;
1342  *t++ = x2 + AM.OffsetVector;
1343  break;
1344  case TSGAMMA: /* Special gamma's */
1345  MesPrint("&5_,6_,7_ can only be used inside g_");
1346  error = -1;
1347  *t++ = -INDEX;
1348  *t++ = -x2;
1349  break;
1350  case TDUBIOUS:
1351  *t++ = -SYMBOL; *t++ = x2; break;
1352  case TFUNCTION:
1353  *t++ = -x2-FUNCTION;
1354  break;
1355  case TSET:
1356  *t++ = -SETSET;
1357  *t++ = x2;
1358  break;
1359  case TWILDARG:
1360  *t++ = -ARGWILD; *t++ = x2; break;
1361  case TSETDOL:
1362  x2 = -x2;
1363  /* fall through */
1364  case TSETNUM:
1365  if ( inset == 0 ) {
1366  w1 = t; t += 2; w2 = t;
1367  while ( w1 > v ) *--w2 = *--w1;
1368  tsize = v; relo = AT.WorkTop;
1369  *v++ = SETSET; *v++ = 0;
1370  inset = 1;
1371  }
1372  *--relo = x2; *--relo = t-v+1;
1373  c = *s++;
1374  x2 = 0; while ( *s >= 0 ) x2 = 128*x2 + *s++;
1375  switch ( c ) {
1376  case TFUNCTION:
1377  (*relo)--; *t++ = -x2-1; break;
1378  case TSYMBOL:
1379  *t++ = -SYMBOL; *t++ = x2; break;
1380  case TINDEX:
1381  *t++ = -INDEX; *t++ = x2;
1382  if ( x2+AM.OffsetIndex > AM.IndDum ) {
1383  x2 = x2+AM.OffsetIndex - AM.IndDum;
1384  if ( x2 > C->numdum[numexp] ) C->numdum[numexp] = x2;
1385  }
1386  break;
1387  case TVECTOR:
1388  *t++ = -VECTOR; *t++ = x2; break;
1389  case TNUMBER1:
1390  *t++ = -SNUMBER; *t++ = x2; break;
1391  default:
1392  MesPrint("&Internal error 435");
1393  error = 1;
1394  *t++ = -SYMBOL; *t++ = x2; break;
1395  }
1396  break;
1397  case TSUBEXP:
1398  w2 = AC.ProtoType; i = w2[1];
1399  w1 = t;
1400  *t++ = i+ARGHEAD+4;
1401  *t++ = 1;
1402  FILLARG(t);
1403  *t++ = i + 4;
1404  while ( --i >= 0 ) *t++ = *w2++;
1405  w1[ARGHEAD+3] = subexpbuffers[x2].subexpnum;
1406  w1[ARGHEAD+5] = subexpbuffers[x2].buffernum;
1407  if ( sumlevel > 0 ) {
1408  w1[0] += 4;
1409  w1[ARGHEAD] += 4;
1410  w1[ARGHEAD+2] += 4;
1411  *t++ = sumtype; *t++ = 4;
1412  *t++ = sumlevel; *t++ = sumlevel;
1413  }
1414  *t++ = 1; *t++ = 1;
1415  if ( minus ) *t++ = -3;
1416  else *t++ = 3;
1417  break;
1418  case TNUMBER:
1419  case TNUMBER1:
1420  if ( minus ) x2 = UnsignedToInt(-IntAbs(x2));
1421  *t++ = -SNUMBER;
1422  *t++ = x2;
1423  break;
1424  default:
1425  MesPrint("&Illegal object in function");
1426  error = -1;
1427  break;
1428  }
1429  } while ( *s == TCOMMA );
1430  }
1431  if ( *s != TFUNCLOSE ) {
1432  MesPrint("&Illegal argument field for function. Expected )");
1433  return(-1);
1434  }
1435  s++; sumlevel = 0;
1436  v[1] = t-v;
1437 /*
1438  if ( *v == AM.termfunnum && ( v[1] != FUNHEAD+2 ||
1439  v[FUNHEAD] != -DOLLAREXPRESSION ) ) {
1440  MesPrint("&The function term_ can only have one argument with a single $-expression");
1441  error = 1;
1442  }
1443 */
1444  goto fin;
1445  case TDUBIOUS:
1446  x1 = 0; while ( *s >= 0 ) x1 = 128*x1 + *s++;
1447  if ( *s == TWILDCARD ) s++;
1448  if ( *s == TDOT ) goto dovector;
1449  if ( *s == TFUNOPEN ) {
1450  x1 += FUNCTION;
1451  cc = 1;
1452  v = t; *t++ = x1; *t++ = FUNHEAD; *t++ = DIRTYFLAG;
1453  if ( x1 == AR.PolyFun && AR.PolyFunType == 2 && AR.Eside != LHSIDE )
1454  t[-1] |= MUSTCLEANPRF;
1455  FILLFUN3(t)
1456  needarg = -1; goto dofunction;
1457  }
1458  *t++ = SYMBOL; *t++ = 4; *t++ = 0;
1459  if ( inset ) *relo = 2;
1460  goto TryPower;
1461  case TSUBEXP:
1462  x1 = 0; while ( *s >= 0 ) { x1 = x1*128 + *s++; }
1463  if ( *s == TPOWER ) {
1464  s++; c = *s++;
1465  base = ( c == TNUMBER ) ? 100: 128;
1466  x2 = 0; while ( *s >= 0 ) { x2 = base*x2 + *s++; }
1467  if ( *s == TWILDCARD ) { x2 += 2*MAXPOWER; s++; }
1468  else if ( c == TSYMBOL ) x2 += 2*MAXPOWER;
1469  }
1470  else x2 = 1;
1471  r = AC.ProtoType; n = r[1] - 5; r += 5;
1472  *t++ = SUBEXPRESSION; *t++ = r[-4];
1473  *t++ = subexpbuffers[x1].subexpnum;
1474  *t++ = x2*deno;
1475  *t++ = subexpbuffers[x1].buffernum;
1476  NCOPY(t,r,n);
1477  if ( cbuf[subexpbuffers[x1].buffernum].CanCommu[subexpbuffers[x1].subexpnum] ) cc = 1;
1478  deno = 1;
1479  break;
1480  case TMULTIPLY:
1481  mulflag = 1;
1482  break;
1483  case TDIVIDE:
1484  mulflag = 1;
1485  deno = -deno;
1486  break;
1487  case TEXPRESSION:
1488  cc = 1;
1489  x1 = 0; while ( *s >= 0 ) { x1 = x1*128 + *s++; }
1490  v = t;
1491  *t++ = EXPRESSION; *t++ = SUBEXPSIZE; *t++ = x1; *t++ = deno;
1492  *t++ = 0; FILLSUB(t)
1493 /*
1494  Here we had some erroneous code before. It should be after
1495  the reading of the parameters as it is now (after 15-jan-2007).
1496  Thomas Hahn noticed this and reported it.
1497 */
1498  if ( *s == TFUNOPEN ) {
1499  do {
1500  s++; c = *s++;
1501  base = ( c == TNUMBER ) ? 100: 128;
1502  x2 = 0; while ( *s >= 0 ) { x2 = base*x2 + *s++; }
1503  switch ( c ) {
1504  case TSYMBOL:
1505  *t++ = SYMBOL; *t++ = 4; *t++ = x2; *t++ = 1;
1506  break;
1507  case TINDEX:
1508  *t++ = INDEX; *t++ = 3; *t++ = x2+AM.OffsetIndex;
1509  if ( t[-1] > AM.IndDum ) {
1510  x2 = t[-1] - AM.IndDum;
1511  if ( x2 > C->numdum[numexp] ) C->numdum[numexp] = x2;
1512  }
1513  break;
1514  case TVECTOR:
1515  *t++ = INDEX; *t++ = 3; *t++ = x2+AM.OffsetVector;
1516  break;
1517  case TFUNCTION:
1518  *t++ = x2+FUNCTION; *t++ = 2; break;
1519  case TNUMBER:
1520  case TNUMBER1:
1521  if ( x2 >= AM.OffsetIndex || x2 < 0 ) {
1522  MesPrint("&Index as argument of expression has illegal value");
1523  error = -1;
1524  }
1525  *t++ = INDEX; *t++ = 3; *t++ = x2; break;
1526  case TSETDOL:
1527  x2 = -x2;
1528  /* fall through */
1529  case TSETNUM:
1530  if ( inset == 0 ) {
1531  w1 = t; t += 2; w2 = t;
1532  while ( w1 > v ) *--w2 = *--w1;
1533  tsize = v; relo = AT.WorkTop;
1534  *v++ = SETSET; *v++ = 0;
1535  inset = 1;
1536  }
1537  *--relo = x2; *--relo = t-v+2;
1538  c = *s++;
1539  x2 = 0; while ( *s >= 0 ) x2 = 128*x2 + *s++;
1540  switch ( c ) {
1541  case TFUNCTION:
1542  *relo -= 2; *t++ = -x2-1; break;
1543  case TSYMBOL:
1544  *t++ = SYMBOL; *t++ = 4; *t++ = x2; *t++ = 1; break;
1545  case TINDEX:
1546  *t++ = INDEX; *t++ = 3; *t++ = x2;
1547  if ( x2+AM.OffsetIndex > AM.IndDum ) {
1548  x2 = x2+AM.OffsetIndex - AM.IndDum;
1549  if ( x2 > C->numdum[numexp] ) C->numdum[numexp] = x2;
1550  }
1551  break;
1552  case TVECTOR:
1553  *t++ = VECTOR; *t++ = 3; *t++ = x2; break;
1554  case TNUMBER1:
1555  *t++ = SNUMBER; *t++ = 4; *t++ = x2; *t++ = 1; break;
1556  default:
1557  MesPrint("&Internal error 435");
1558  error = 1;
1559  *t++ = SYMBOL; *t++ = 4; *t++ = x2; *t++ = 1; break;
1560  }
1561  break;
1562  default:
1563  MesPrint("&Argument of expression can only be symbol, index, vector or function");
1564  error = -1;
1565  break;
1566  }
1567  } while ( *s == TCOMMA );
1568  if ( *s != TFUNCLOSE ) {
1569  MesPrint("&Illegal object in argument field for expression");
1570  error = -1;
1571  while ( *s != TFUNCLOSE ) s++;
1572  }
1573  s++;
1574  }
1575  r = AC.ProtoType; n = r[1];
1576  if ( n > SUBEXPSIZE ) {
1577  *t++ = WILDCARDS; *t++ = n+2;
1578  NCOPY(t,r,n);
1579  }
1580 /*
1581  Code added for parallel processing.
1582  This is different from the other occurrences to test immediately
1583  for renumbering. Here we have to read the parameters first.
1584 */
1585  if ( Expressions[x1].status == STOREDEXPRESSION ) {
1586  v[1] = t-v;
1587  AT.TMaddr = v;
1588  PUTZERO(position);
1589 /*
1590  if ( (
1591 #ifdef WITHPTHREADS
1592  renumber =
1593 #endif
1594  GetTable(x1,&position,0) ) == 0 ) {
1595  error = 1;
1596  MesPrint("&Problems getting information about stored expression %s(3)"
1597  ,EXPRNAME(x1));
1598  }
1599 #ifdef WITHPTHREADS
1600  M_free(renumber->symb.lo,"VarSpace");
1601  M_free(renumber,"Renumber");
1602 #endif
1603 */
1604  if ( ( renumber = GetTable(x1,&position,0) ) == 0 ) {
1605  error = 1;
1606  MesPrint("&Problems getting information about stored expression %s(3)"
1607  ,EXPRNAME(x1));
1608  }
1609  if ( renumber->symb.lo != AN.dummyrenumlist )
1610  M_free(renumber->symb.lo,"VarSpace");
1611  M_free(renumber,"Renumber");
1612  AR.StoreData.dirtyflag = 1;
1613  }
1614  if ( *s == LBRACE ) {
1615 /*
1616  This should be one term that should be inserted
1617  FROMBRAC size+2 ( term )
1618  Because this term should have been translated
1619  already we can copy it from the 'subexpression'
1620 */
1621  s++;
1622  if ( *s != TSUBEXP ) {
1623  MesPrint("&Internal error 23");
1624  Terminate(-1);
1625  }
1626  s++; x2 = 0; while ( *s >= 0 ) { x2 = 128*x2 + *s++; }
1627  r = cbuf[subexpbuffers[x2].buffernum].rhs[subexpbuffers[x2].subexpnum];
1628  *t++ = FROMBRAC; *t++ = *r+2;
1629  n = *r;
1630  NCOPY(t,r,n);
1631  if ( *r != 0 ) {
1632  MesPrint("&Object between [] in expression should be a single term");
1633  error = -1;
1634  }
1635  if ( *s != RBRACE ) {
1636  MesPrint("&Internal error 23b");
1637  Terminate(-1);
1638  }
1639  s++;
1640  }
1641  if ( *s == TPOWER ) {
1642  s++; c = *s++;
1643  base = ( c == TNUMBER ) ? 100: 128;
1644  x2 = 0; while ( *s >= 0 ) { x2 = base*x2 + *s++; }
1645  if ( *s == TWILDCARD || c == TSYMBOL ) { x2 += 2*MAXPOWER; s++; }
1646  v[3] = x2;
1647  }
1648  v[1] = t - v;
1649  deno = 1;
1650  break;
1651  case TNUMBER:
1652  if ( *s == 0 ) {
1653  s++;
1654  if ( *s == TPOWER ) {
1655  s++; if ( *s == TMINUS ) { s++; deno = -deno; }
1656  c = *s++; base = ( c == TNUMBER ) ? 100: 128;
1657  x2 = 0; while ( *s >= 0 ) { x2 = x2*base + *s++; }
1658  if ( x2 == 0 ) {
1659  error = -1;
1660  MesPrint("&Encountered 0^0 during compilation");
1661  }
1662  if ( deno < 0 ) {
1663  error = -1;
1664  MesPrint("&Division by zero during compilation (0 to the power negative number)");
1665  }
1666  }
1667  else if ( deno < 0 ) {
1668  error = -1;
1669  MesPrint("&Division by zero during compilation");
1670  }
1671  sign = 0; break; /* term is zero */
1672  }
1673  y = *s++;
1674  if ( *s >= 0 ) { y = 100*y + *s++; }
1675  innum[0] = y; nin = 1;
1676  while ( *s >= 0 ) {
1677  y = *s++; x2 = 100;
1678  if ( *s >= 0 ) { y = 100*y + *s++; x2 = 10000; }
1679  Product(innum,&nin,(WORD)x2);
1680  if ( y ) AddLong(innum,nin,(UWORD *)(&y),(WORD)1,innum,&nin);
1681  }
1682 docoef:
1683  if ( *s == TPOWER ) {
1684  s++; if ( *s == TMINUS ) { s++; deno = -deno; }
1685  c = *s++; base = ( c == TNUMBER ) ? 100: 128;
1686  x2 = 0; while ( *s >= 0 ) { x2 = x2*base + *s++; }
1687  if ( x2 == 0 ) {
1688  innum[0] = 1; nin = 1;
1689  }
1690  else if ( RaisPow(BHEAD innum,&nin,x2) ) {
1691  error = -1; innum[0] = 1; nin = 1;
1692  }
1693  }
1694  if ( deno > 0 ) {
1695  Simplify(BHEAD innum,&nin,denominator,&ndenominator);
1696  for ( i = 0; i < nnumerator; i++ ) CGscrat7[i] = numerator[i];
1697  MulLong(innum,nin,CGscrat7,nnumerator,numerator,&nnumerator);
1698  }
1699  else if ( deno < 0 ) {
1700  Simplify(BHEAD innum,&nin,numerator,&nnumerator);
1701  for ( i = 0; i < ndenominator; i++ ) CGscrat7[i] = denominator[i];
1702  MulLong(innum,nin,CGscrat7,ndenominator,denominator,&ndenominator);
1703  }
1704  deno = 1;
1705  break;
1706  case TNUMBER1:
1707  if ( *s == 0 ) { s++; sign = 0; break; /* term is zero */ }
1708  y = *s++;
1709  if ( *s >= 0 ) { y = 128*y + *s++; }
1710  if ( inset == 0 ) {
1711  innum[0] = y; nin = 1;
1712  while ( *s >= 0 ) {
1713  y = *s++; x2 = 128;
1714  if ( *s >= 0 ) { y = 128*y + *s++; x2 = 16384; }
1715  Product(innum,&nin,(WORD)x2);
1716  if ( y ) AddLong(innum,nin,(UWORD *)&y,(WORD)1,innum,&nin);
1717  }
1718  goto docoef;
1719  }
1720  *relo = 2; *t++ = SNUMBER; *t++ = 4; *t++ = y;
1721  goto TryPower;
1722  case TDOLLAR:
1723  {
1724  WORD *powplace;
1725  x1 = 0; while ( *s >= 0 ) { x1 = x1*128 + *s++; }
1726  if ( AR.Eside != LHSIDE ) {
1727  *t++ = SUBEXPRESSION; *t++ = SUBEXPSIZE; *t++ = x1;
1728  }
1729  else {
1730  *t++ = DOLLAREXPRESSION; *t++ = SUBEXPSIZE; *t++ = x1;
1731  }
1732  powplace = t; t++;
1733  *t++ = AM.dbufnum; FILLSUB(t)
1734 /*
1735  Now we have to test for factors of dollars with [ ] and [ [ ]]
1736 */
1737  if ( *s == LBRACE ) {
1738  int bracelevel = 1;
1739  s++;
1740  while ( bracelevel > 0 ) {
1741  if ( *s == RBRACE ) {
1742  bracelevel--; s++;
1743  }
1744  else if ( *s == TNUMBER ) {
1745  s++;
1746  x2 = 0; while ( *s >= 0 ) { x2 = 100*x2 + *s++; }
1747  *t++ = DOLLAREXPR2; *t++ = 3; *t++ = -x2-1;
1748 CloseBraces:
1749  while ( bracelevel > 0 ) {
1750  if ( *s != RBRACE ) {
1751 ErrorBraces:
1752  error = -1;
1753  MesPrint("&Improper use of [] in $-variable.");
1754  return(error);
1755  }
1756  else {
1757  s++; bracelevel--;
1758  }
1759  }
1760  }
1761  else if ( *s == TDOLLAR ) {
1762  s++;
1763  x1 = 0; while ( *s >= 0 ) { x1 = x1*128 + *s++; }
1764  *t++ = DOLLAREXPR2; *t++ = 3; *t++ = x1;
1765  if ( *s == RBRACE ) goto CloseBraces;
1766  else if ( *s == LBRACE ) {
1767  s++; bracelevel++;
1768  }
1769  }
1770  else goto ErrorBraces;
1771  }
1772  }
1773 /*
1774  Finally we can continue with the power
1775 */
1776  if ( *s == TPOWER ) {
1777  s++;
1778  if ( *s == TMINUS ) { s++; deno = -deno; }
1779  c = *s++;
1780  base = ( c == TNUMBER ) ? 100: 128;
1781  x2 = 0; while ( *s >= 0 ) { x2 = base*x2 + *s++; }
1782  if ( c == TSYMBOL ) {
1783  if ( *s == TWILDCARD ) s++;
1784  x2 += 2*MAXPOWER;
1785  }
1786  *powplace = deno*x2;
1787  }
1788  else *powplace = deno;
1789  deno = 1;
1790 /*
1791  if ( inset ) {
1792  while ( relo < AT.WorkTop ) *t++ = *relo++;
1793  inset = 0; tsize[1] = t - tsize;
1794  }
1795 */
1796  }
1797  break;
1798  case TSETNUM:
1799  inset = 1; tsize = t; relo = AT.WorkTop;
1800  *t++ = SETSET; *t++ = 0;
1801  x1 = 0; while ( *s >= 0 ) x1 = x1*128 + *s++;
1802  *--relo = x1; *--relo = 0;
1803  break;
1804  case TSETDOL:
1805  inset = 1; tsize = t; relo = AT.WorkTop;
1806  *t++ = SETSET; *t++ = 0;
1807  x1 = 0; while ( *s >= 0 ) x1 = x1*128 + *s++;
1808  *--relo = -x1; *--relo = 0;
1809  break;
1810  case TFUNOPEN:
1811  MesPrint("&Illegal use of function arguments");
1812  error = -1;
1813  funflag = 1;
1814  deno = 1;
1815  break;
1816  case TFUNCLOSE:
1817  if ( funflag == 0 )
1818  MesPrint("&Illegal use of function arguments");
1819  error = -1;
1820  funflag = 0;
1821  deno = 1;
1822  break;
1823  case TSGAMMA:
1824  MesPrint("&Illegal use special gamma symbols 5_, 6_, 7_");
1825  error = -1;
1826  funflag = 0;
1827  deno = 1;
1828  break;
1829  default:
1830  MesPrint("&Internal error in code generator. Unknown object: %d",c);
1831  error = -1;
1832  deno = 1;
1833  break;
1834  }
1835  }
1836  }
1837  if ( mulflag ) {
1838  MesPrint("&Irregular end of statement.");
1839  error = 1;
1840  }
1841  if ( !first && error == 0 ) {
1842  *term = t-term;
1843  C->NumTerms[numexp]++;
1844  if ( cc && sign ) C->CanCommu[numexp]++;
1845  error = CompleteTerm(term,numerator,denominator,nnumerator,ndenominator,sign);
1846  }
1847  AT.WorkPointer = oldwork;
1848  if ( error ) return(-1);
1849  AddToCB(C,0)
1850  if ( AC.CompileLevel > 0 && AR.Eside != LHSIDE ) {
1851  /* See whether we have this one already */
1852  error = InsTree(AC.cbufnum,C->numrhs);
1853  if ( error < (C->numrhs) ) {
1854  C->Pointer = C->rhs[C->numrhs--];
1855  return(error);
1856  }
1857  }
1858  return(C->numrhs);
1859 OverWork:
1860  MLOCK(ErrorMessageLock);
1861  MesWork();
1862  MUNLOCK(ErrorMessageLock);
1863  return(-1);
1864 }
1865 
1866 /*
1867  #] CodeGenerator :
1868  #[ CompleteTerm :
1869 
1870  Completes the term
1871  Puts it in the buffer
1872 */
1873 
1874 int CompleteTerm(WORD *term, UWORD *numer, UWORD *denom, WORD nnum, WORD nden, int sign)
1875 {
1876  int nsize, i;
1877  WORD *t;
1878  if ( sign == 0 ) return(0); /* Term is zero */
1879  if ( nnum >= nden ) nsize = nnum;
1880  else nsize = nden;
1881  t = term + *term;
1882  for ( i = 0; i < nnum; i++ ) *t++ = numer[i];
1883  for ( ; i < nsize; i++ ) *t++ = 0;
1884  for ( i = 0; i < nden; i++ ) *t++ = denom[i];
1885  for ( ; i < nsize; i++ ) *t++ = 0;
1886  *t++ = (2*nsize+1)*sign;
1887  *term = t - term;
1888  AddNtoC(AC.cbufnum,*term,term,7);
1889  return(0);
1890 }
1891 
1892 /*
1893  #] CompleteTerm :
1894  #[ CodeFactors :
1895 
1896  This routine does the part of reading in in terms of factors.
1897  If there is more than one term at this level we have only one
1898  factor. In that case any expression should first be unfactorized.
1899  Then the whole expression gets read as a new subexpression and finally
1900  we generate factor_*subexpression.
1901  If the whole has only multiplications we have factors. Then the
1902  nasty thing is powers of objects and in particular powers of
1903  factorized expressions or dollars.
1904  For a power we generate a new subexpression of the type
1905  1+factor_+...+factor_^(power-1)
1906  with which we multiply.
1907 
1908  WE HAVE NOT YET WORRIED ABOUT SETS
1909 */
1910 
1911 int CodeFactors(SBYTE *tokens)
1912 {
1913  GETIDENTITY
1914  EXPRESSIONS e = Expressions + AR.CurExpr;
1915  int nfactor = 1, nparenthesis, i, last = 0, error = 0;
1916  SBYTE *t, *startobject, *tt, *s1, *out, *outtokens;
1917  WORD nexp, subexp = 0, power, pow, x2, powfactor, first;
1918 /*
1919  First scan the number of factors
1920 */
1921  t = tokens;
1922  while ( *t != TENDOFIT ) {
1923  if ( *t >= 0 ) { while ( *t >= 0 ) t++; continue; }
1924  if ( *t == LPARENTHESIS || *t == LBRACE || *t == TSETOPEN || *t == TFUNOPEN ) {
1925  nparenthesis = 0; t++;
1926  while ( nparenthesis >= 0 ) {
1927  if ( *t == LPARENTHESIS || *t == LBRACE || *t == TSETOPEN || *t == TFUNOPEN ) nparenthesis++;
1928  else if ( *t == RPARENTHESIS || *t == RBRACE || *t == TSETCLOSE || *t == TFUNCLOSE ) nparenthesis--;
1929  t++;
1930  }
1931  continue;
1932  }
1933  else if ( ( *t == TPLUS || *t == TMINUS ) && ( t > tokens )
1934  && ( t[-1] != TPLUS && t[-1] != TMINUS ) ) {
1935  if ( t[-1] >= 0 || t[-1] == RPARENTHESIS || t[-1] == RBRACE
1936  || t[-1] == TSETCLOSE || t[-1] == TFUNCLOSE ) {
1937  subexp = CodeGenerator(tokens);
1938  if ( subexp < 0 ) error = -1;
1939  if ( insubexpbuffers >= MAXSUBEXPRESSIONS ) {
1940  MesPrint("&More than %d subexpressions inside one expression",(WORD)MAXSUBEXPRESSIONS);
1941  Terminate(-1);
1942  }
1943  if ( subexpbuffers+insubexpbuffers >= topsubexpbuffers ) {
1944  DoubleBuffer((void **)((VOID *)(&subexpbuffers))
1945  ,(void **)((VOID *)(&topsubexpbuffers)),sizeof(SUBBUF),"subexpbuffers");
1946  }
1947  subexpbuffers[insubexpbuffers].subexpnum = subexp;
1948  subexpbuffers[insubexpbuffers].buffernum = AC.cbufnum;
1949  subexp = insubexpbuffers++;
1950  t = tokens;
1951  *t++ = TSYMBOL; *t++ = FACTORSYMBOL;
1952  *t++ = TMULTIPLY; *t++ = TSUBEXP;
1953  PUTNUMBER128(t,subexp)
1954  *t++ = TENDOFIT;
1955  e->numfactors = 1;
1956  e->vflags |= ISFACTORIZED;
1957  return(subexp);
1958  }
1959  }
1960  else if ( ( *t == TMULTIPLY || *t == TDIVIDE ) && t > tokens ) {
1961  nfactor++;
1962  }
1963  else if ( *t == TEXPRESSION ) {
1964  t++;
1965  nexp = 0; while ( *t >= 0 ) { nexp = nexp*128 + *t++; }
1966  if ( *t == LBRACE ) continue;
1967  if ( ( AS.Oldvflags[nexp] & ISFACTORIZED ) != 0 ) {
1968  nfactor += AS.OldNumFactors[nexp];
1969  }
1970  else { nfactor++; }
1971  continue;
1972  }
1973  else if ( *t == TDOLLAR ) {
1974  t++;
1975  nexp = 0; while ( *t >= 0 ) { nexp = nexp*128 + *t++; }
1976  if ( *t == LBRACE ) continue;
1977  if ( Dollars[nexp].nfactors > 0 ) {
1978  nfactor += Dollars[nexp].nfactors;
1979  }
1980  else { nfactor++; }
1981  continue;
1982  }
1983  t++;
1984  }
1985 /*
1986  Now the real pass.
1987  nfactor is a not so reliable measure for the space we need.
1988 */
1989  outtokens = (SBYTE *)Malloc1(((t-tokens)+(nfactor+2)*25)*sizeof(SBYTE),"CodeFactors");
1990  out = outtokens;
1991  t = tokens; first = 1; powfactor = 1;
1992  while ( *t == TPLUS || *t == TMINUS ) { if ( *t == TMINUS ) first = -first; t++; }
1993  if ( first < 0 ) {
1994  *out++ = TMINUS; *out++ = TSYMBOL; *out++ = FACTORSYMBOL;
1995  *out++ = TPOWER; *out++ = TNUMBER; PUTNUMBER100(out,powfactor)
1996  powfactor++;
1997  }
1998  startobject = t; power = 1;
1999  while ( *t != TENDOFIT ) {
2000  if ( *t >= 0 ) { while ( *t >= 0 ) t++; continue; }
2001  if ( *t == LPARENTHESIS || *t == LBRACE || *t == TSETOPEN || *t == TFUNOPEN ) {
2002  nparenthesis = 0; t++;
2003  while ( nparenthesis >= 0 ) {
2004  if ( *t == LPARENTHESIS || *t == LBRACE || *t == TSETOPEN || *t == TFUNOPEN ) nparenthesis++;
2005  else if ( *t == RPARENTHESIS || *t == RBRACE || *t == TSETCLOSE || *t == TFUNCLOSE ) nparenthesis--;
2006  t++;
2007  }
2008  continue;
2009  }
2010  else if ( ( *t == TMULTIPLY || *t == TDIVIDE ) && ( t > tokens ) ) {
2011  if ( t[-1] >= 0 || t[-1] == RPARENTHESIS || t[-1] == RBRACE
2012  || t[-1] == TSETCLOSE || t[-1] == TFUNCLOSE ) {
2013 dolast:
2014  if ( startobject ) { /* apparently power is 1 or -1 */
2015  *out++ = TPLUS;
2016  if ( power < 0 ) { *out++ = TNUMBER; *out++ = 1; *out++ = TDIVIDE; }
2017  s1 = startobject;
2018  while ( s1 < t ) *out++ = *s1++;
2019  *out++ = TMULTIPLY; *out++ = TSYMBOL; *out++ = FACTORSYMBOL;
2020  *out++ = TPOWER; *out++ = TNUMBER; PUTNUMBER100(out,powfactor)
2021  powfactor++;
2022  }
2023  if ( last ) { startobject = 0; break; }
2024  startobject = t+1;
2025  if ( *t == TDIVIDE ) power = -1;
2026  if ( *t == TMULTIPLY ) power = 1;
2027  }
2028  }
2029  else if ( *t == TPOWER ) {
2030  pow = 1;
2031  tt = t+1;
2032  while ( ( *tt == TMINUS ) || ( *tt == TPLUS ) ) {
2033  if ( *tt == TMINUS ) pow = -pow;
2034  tt++;
2035  }
2036  if ( *tt == TSYMBOL ) {
2037  tt++; while ( *tt >= 0 ) tt++;
2038  t = tt; continue;
2039  }
2040  tt++; x2 = 0; while ( *tt >= 0 ) { x2 = 100*x2 + *tt++; }
2041 /*
2042  We have an object in startobject till t. The power is
2043  power*pow*x2
2044 */
2045  power = power*pow*x2;
2046  if ( power < 0 ) { pow = -power; power = -1; }
2047  else if ( power == 0 ) { t = tt; startobject = tt; continue; }
2048  else { pow = power; power = 1; }
2049  *out++ = TPLUS;
2050  if ( pow > 1 ) {
2051  subexp = GenerateFactors(pow,1);
2052  if ( subexp < 0 ) { error = -1; subexp = 0; }
2053  *out++ = TSUBEXP; PUTNUMBER128(out,subexp);
2054  }
2055  *out++ = TSYMBOL; *out++ = FACTORSYMBOL;
2056  *out++ = TPOWER; *out++ = TNUMBER; PUTNUMBER100(out,powfactor)
2057  powfactor += pow;
2058  if ( power > 0 ) *out++ = TMULTIPLY;
2059  else *out++ = TDIVIDE;
2060  s1 = startobject; while ( s1 < t ) *out++ = *s1++;
2061  startobject = 0; t = tt; continue;
2062  }
2063  else if ( *t == TEXPRESSION ) {
2064  startobject = t;
2065  t++;
2066  nexp = 0; while ( *t >= 0 ) { nexp = nexp*128 + *t++; }
2067  if ( *t == LBRACE ) continue;
2068  if ( *t == LPARENTHESIS ) {
2069  nparenthesis = 0; t++;
2070  while ( nparenthesis >= 0 ) {
2071  if ( *t == LPARENTHESIS ) nparenthesis++;
2072  else if ( *t == RPARENTHESIS ) nparenthesis--;
2073  t++;
2074  }
2075  }
2076  if ( ( AS.Oldvflags[nexp] & ISFACTORIZED ) == 0 ) continue;
2077  if ( *t == TPOWER ) {
2078  pow = 1;
2079  tt = t+1;
2080  while ( ( *tt == TMINUS ) || ( *tt == TPLUS ) ) {
2081  if ( *tt == TMINUS ) pow = -pow;
2082  tt++;
2083  }
2084  if ( *tt != TNUMBER ) {
2085  MesPrint("Internal problems(1) in CodeFactors");
2086  return(-1);
2087  }
2088  tt++; x2 = 0; while ( *tt >= 0 ) { x2 = 100*x2 + *tt++; }
2089 /*
2090  We have an object in startobject till t. The power is
2091  power*pow*x2
2092 */
2093 dopower:
2094  power = power*pow*x2;
2095  if ( power < 0 ) { pow = -power; power = -1; }
2096  else if ( power == 0 ) { t = tt; startobject = tt; continue; }
2097  else { pow = power; power = 1; }
2098  *out++ = TPLUS;
2099  if ( pow > 1 ) {
2100  subexp = GenerateFactors(pow,AS.OldNumFactors[nexp]);
2101  if ( subexp < 0 ) { error = -1; subexp = 0; }
2102  *out++ = TSUBEXP; PUTNUMBER128(out,subexp)
2103  *out++ = TMULTIPLY;
2104  }
2105  i = powfactor-1;
2106  if ( i > 0 ) {
2107  *out++ = TSYMBOL; *out++ = FACTORSYMBOL;
2108  if ( i > 1 ) {
2109  *out++ = TPOWER; *out++ = TNUMBER; PUTNUMBER100(out,i)
2110  }
2111  *out++ = TMULTIPLY;
2112  }
2113  powfactor += AS.OldNumFactors[nexp]*pow;
2114  s1 = startobject;
2115  while ( s1 < t ) *out++ = *s1++;
2116  startobject = 0; t = tt; continue;
2117  }
2118  else {
2119  tt = t; pow = 1; x2 = 1; goto dopower;
2120  }
2121  }
2122  else if ( *t == TDOLLAR ) {
2123  startobject = t;
2124  t++;
2125  nexp = 0; while ( *t >= 0 ) { nexp = nexp*128 + *t++; }
2126  if ( *t == LBRACE ) continue;
2127  if ( Dollars[nexp].nfactors == 0 ) continue;
2128  if ( *t == TPOWER ) {
2129  pow = 1;
2130  tt = t+1;
2131  while ( ( *tt == TMINUS ) || ( *tt == TPLUS ) ) {
2132  if ( *tt == TMINUS ) pow = -pow;
2133  tt++;
2134  }
2135  if ( *tt != TNUMBER ) {
2136  MesPrint("Internal problems(2) in CodeFactors");
2137  return(-1);
2138  }
2139  tt++; x2 = 0; while ( *tt >= 0 ) { x2 = 100*x2 + *tt++; }
2140 /*
2141  We have an object in startobject till t. The power is
2142  power*pow*x2
2143 */
2144 dopowerd:
2145  power = power*pow*x2;
2146  if ( power < 0 ) { pow = -power; power = -1; }
2147  else if ( power == 0 ) { t = tt; startobject = tt; continue; }
2148  else { pow = power; power = 1; }
2149  if ( pow > 1 ) {
2150  subexp = GenerateFactors(pow,1);
2151  if ( subexp < 0 ) { error = -1; subexp = 0; }
2152  }
2153  for ( i = 1; i <= Dollars[nexp].nfactors; i++ ) {
2154  s1 = startobject; *out++ = TPLUS;
2155  while ( s1 < t ) *out++ = *s1++;
2156  *out++ = LBRACE; *out++ = TNUMBER; PUTNUMBER128(out,i)
2157  *out++ = RBRACE;
2158  *out++ = TMULTIPLY;
2159  *out++ = TSYMBOL; *out++ = FACTORSYMBOL;
2160  *out++ = TPOWER; *out++ = TNUMBER; PUTNUMBER100(out,powfactor)
2161  powfactor += pow;
2162  if ( pow > 1 ) {
2163  *out++ = TSUBEXP; PUTNUMBER128(out,subexp)
2164  }
2165  }
2166  startobject = 0; t = tt; continue;
2167  }
2168  else {
2169  tt = t; pow = 1; x2 = 1; goto dopowerd;
2170  }
2171  }
2172  t++;
2173  }
2174  if ( last == 0 ) { last = 1; goto dolast; }
2175  *out = TENDOFIT;
2176  e->numfactors = powfactor-1;
2177  e->vflags |= ISFACTORIZED;
2178  subexp = CodeGenerator(outtokens);
2179  if ( subexp < 0 ) error = -1;
2180  if ( insubexpbuffers >= MAXSUBEXPRESSIONS ) {
2181  MesPrint("&More than %d subexpressions inside one expression",(WORD)MAXSUBEXPRESSIONS);
2182  Terminate(-1);
2183  }
2184  if ( subexpbuffers+insubexpbuffers >= topsubexpbuffers ) {
2185  DoubleBuffer((void **)((VOID *)(&subexpbuffers))
2186  ,(void **)((VOID *)(&topsubexpbuffers)),sizeof(SUBBUF),"subexpbuffers");
2187  }
2188  subexpbuffers[insubexpbuffers].subexpnum = subexp;
2189  subexpbuffers[insubexpbuffers].buffernum = AC.cbufnum;
2190  subexp = insubexpbuffers++;
2191  M_free(outtokens,"CodeFactors");
2192  s1 = tokens;
2193  *s1++ = TSUBEXP; PUTNUMBER128(s1,subexp); *s1++ = TENDOFIT;
2194  if ( error < 0 ) return(-1);
2195  else return(subexp);
2196 }
2197 
2198 /*
2199  #] CodeFactors :
2200  #[ GenerateFactors :
2201 
2202  Generates an expression of the type
2203  1+factor_+factor_^2+...+factor_^(n-1)
2204  (this is if inc=1)
2205  Returns the subexpression pointer of it.
2206 */
2207 
2208 WORD GenerateFactors(WORD n,WORD inc)
2209 {
2210  WORD subexp;
2211  int i, error = 0;
2212  SBYTE *s;
2213  SBYTE *tokenbuffer = (SBYTE *)Malloc1(8*n*sizeof(SBYTE),"GenerateFactors");
2214  s = tokenbuffer;
2215  *s++ = TNUMBER; *s++ = 1;
2216  for ( i = inc; i < n*inc; i += inc ) {
2217  *s++ = TPLUS; *s++ = TSYMBOL; *s++ = FACTORSYMBOL;
2218  if ( i > 1 ) {
2219  *s++ = TPOWER; *s++ = TNUMBER;
2220  PUTNUMBER100(s,i)
2221  }
2222  }
2223  *s++ = TENDOFIT;
2224  subexp = CodeGenerator(tokenbuffer);
2225  if ( subexp < 0 ) error = -1;
2226  M_free(tokenbuffer,"GenerateFactors");
2227  if ( insubexpbuffers >= MAXSUBEXPRESSIONS ) {
2228  MesPrint("&More than %d subexpressions inside one expression",(WORD)MAXSUBEXPRESSIONS);
2229  Terminate(-1);
2230  }
2231  if ( subexpbuffers+insubexpbuffers >= topsubexpbuffers ) {
2232  DoubleBuffer((void **)((VOID *)(&subexpbuffers))
2233  ,(void **)((VOID *)(&topsubexpbuffers)),sizeof(SUBBUF),"subexpbuffers");
2234  }
2235  subexpbuffers[insubexpbuffers].subexpnum = subexp;
2236  subexpbuffers[insubexpbuffers].buffernum = AC.cbufnum;
2237  subexp = insubexpbuffers++;
2238  if ( error < 0 ) return(error);
2239  return(subexp);
2240 }
2241 
2242 /*
2243  #] GenerateFactors :
2244  #] Compiler :
2245 */
LONG * NumTerms
Definition: structs.h:945
LONG totind
Definition: structs.h:365
int sparse
Definition: structs.h:373
int strict
Definition: structs.h:372
Definition: structs.h:938
WORD * Pointer
Definition: structs.h:941
TABLES tabl
Definition: structs.h:476
WORD * tablepointers
Definition: structs.h:350
int AddNtoC(int bufnum, int n, WORD *array, int par)
Definition: comtool.c:317
WORD ** rhs
Definition: structs.h:943
WORD * numdum
Definition: structs.h:946
LONG name
Definition: structs.h:478
VARRENUM symb
Definition: structs.h:180
LONG * CanCommu
Definition: structs.h:944
WORD * AddRHS(int num, int type)
Definition: comtool.c:214
WORD * lo
Definition: structs.h:167