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