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