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