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