FORM v5.0.1-33-gdf7fc94
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/* INTERNAL_ERROR_EXCL_START */
1127 error = 1;
1128 MesPrint("!>Problems getting information about stored expression %s(1)"
1129 ,EXPRNAME(x2));
1130/* INTERNAL_ERROR_EXCL_STOP */
1131 }
1132 if ( renumber->symb.lo != AN.dummyrenumlist )
1133 M_free(renumber->symb.lo,"VarSpace");
1134 M_free(renumber,"Renumber");
1135 AR.StoreData.dirtyflag = 1;
1136 }
1137 if ( *s != TFUNCLOSE ) {
1138 if ( x1 == FIRSTBRACKET )
1139 MesPrint("&Problems with argument of FirstBracket_");
1140 else if ( x1 == FIRSTTERM )
1141 MesPrint("&Problems with argument of FirstTerm_");
1142 else if ( x1 == CONTENTTERM )
1143 MesPrint("&Problems with argument of FirstTerm_");
1144 else if ( x1 == TERMSINEXPR )
1145 MesPrint("&Problems with argument of TermsIn_");
1146 else if ( x1 == SIZEOFFUNCTION )
1147 MesPrint("&Problems with argument of SizeOf_");
1148 else if ( x1 == NUMFACTORS )
1149 MesPrint("&Problems with argument of NumFactors_");
1150 else
1151 MesPrint("&Problems with argument of FactorIn_");
1152 error = 1;
1153 while ( *s != TENDOFIT && *s != TFUNCLOSE ) s++;
1154 }
1155 if ( *s == TFUNCLOSE ) s++;
1156 goto fin;
1157 }
1158 }
1159 else if ( x1 == TERMSINEXPR || x1 == SIZEOFFUNCTION || x1 == FACTORIN
1160 || x1 == NUMFACTORS || x1 == FIRSTTERM || x1 == CONTENTTERM ) {
1161 if ( s[0] == TFUNOPEN && s[1] == TEXPRESSION ) goto doexpr;
1162 if ( s[0] == TFUNOPEN && s[1] == TDOLLAR ) {
1163 s += 2;
1164 *t++ = x1; *t++ = FUNHEAD+2; *t++ = 0;
1165 FILLFUN3(t)
1166 x2 = 0; while ( *s >= 0 ) { x2 = x2*128 + *s++; }
1167 *t++ = -DOLLAREXPRESSION; *t++ = x2;
1168 if ( *s != TFUNCLOSE ) {
1169 if ( x1 == TERMSINEXPR )
1170 MesPrint("&Problems with argument of TermsIn_");
1171 else if ( x1 == SIZEOFFUNCTION )
1172 MesPrint("&Problems with argument of SizeOf_");
1173 else if ( x1 == NUMFACTORS )
1174 MesPrint("&Problems with argument of NumFactors_");
1175 else
1176 MesPrint("&Problems with argument of FactorIn_");
1177 error = 1;
1178 while ( *s != TENDOFIT && *s != TFUNCLOSE ) s++;
1179 }
1180 if ( *s == TFUNCLOSE ) s++;
1181 goto fin;
1182 }
1183 }
1184 x3 = x1;
1185 if ( inset && ( t-tsize == 2 ) ) x1 -= FUNCTION;
1186 if ( *s == TWILDCARD ) { x1 += WILDOFFSET; s++; }
1187 if ( functions[x3-FUNCTION].commute ) cc = 1;
1188 if ( *s != TFUNOPEN ) {
1189 *t++ = x1; *t++ = FUNHEAD; *t++ = 0;
1190 if ( x1 == AR.PolyFun && AR.PolyFunType == 2 && AR.Eside != LHSIDE )
1191 t[-1] |= MUSTCLEANPRF;
1192 FILLFUN3(t) sumlevel = 0; goto fin;
1193 }
1194 v = t; *t++ = x1; *t++ = FUNHEAD; *t++ = DIRTYFLAG;
1195 if ( x1 == AR.PolyFun && AR.PolyFunType == 2 && AR.Eside != LHSIDE )
1196 t[-1] |= MUSTCLEANPRF;
1197 FILLFUN3(t)
1198 needarg = -1;
1199 if ( !inset && functions[x3-FUNCTION].spec >= TENSORFUNCTION ) {
1200dotensor:
1201 do {
1202 if ( needarg == 0 ) {
1203 if ( x1 >= 0 ) {
1204 x3 = x1;
1205 if ( x3 >= FUNCTION+WILDOFFSET ) x3 -= WILDOFFSET;
1206 MesPrint("&Too many arguments in function %s",
1207 VARNAME(functions,(x3-FUNCTION)) );
1208 }
1209 else
1210 MesPrint("&d_ needs exactly two arguments");
1211 error = -1;
1212 needarg--;
1213 }
1214 else if ( needarg > 0 ) needarg--;
1215 s++;
1216 c = *s++;
1217 if ( c == TMINUS && *s == TVECTOR ) { sign = -sign; c = *s++; }
1218 base = ( c == TNUMBER ) ? 100: 128;
1219 x2 = 0; while ( *s >= 0 ) { x2 = base*x2 + *s++; }
1220 if ( *s == TWILDCARD && c != TNUMBER ) { x2 += WILDOFFSET; s++; }
1221 if ( c == TSETNUM || c == TSETDOL ) {
1222 if ( c == TSETDOL ) x2 = -x2;
1223 if ( inset == 0 ) {
1224 w1 = t; t += 2; w2 = t;
1225 while ( w1 > v ) *--w2 = *--w1;
1226 tsize = v; relo = AT.WorkTop;
1227 *v++ = SETSET; *v++ = 0;
1228 }
1229 inset = 2; *--relo = x2; *--relo = t - v;
1230 c = *s++;
1231 x2 = 0; while ( *s >= 0 ) x2 = 128*x2 + *s++;
1232 switch ( c ) {
1233 case TINDEX:
1234 *t++ = x2;
1235 if ( t[-1]+AM.OffsetIndex > AM.IndDum ) {
1236 x2 = t[-1]+AM.OffsetIndex - AM.IndDum;
1237 if ( x2 > C->numdum[numexp] ) C->numdum[numexp] = x2;
1238 }
1239 break;
1240 case TVECTOR:
1241 *t++ = x2; break;
1242 case TNUMBER1:
1243 if ( x2 >= 0 && x2 < AM.OffsetIndex ) {
1244 *t++ = x2; break;
1245 }
1246 /* fall through */
1247 default:
1248 MesPrint("&Illegal type of set inside tensor");
1249 error = 1;
1250 *t++ = x2;
1251 break;
1252 }
1253 }
1254 else { switch ( c ) {
1255 case TINDEX:
1256 if ( inset < 2 ) *t++ = x2 + AM.OffsetIndex;
1257 else *t++ = x2;
1258 if ( x2+AM.OffsetIndex > AM.IndDum ) {
1259 x2 = x2+AM.OffsetIndex - AM.IndDum;
1260 if ( x2 > C->numdum[numexp] ) C->numdum[numexp] = x2;
1261 }
1262 break;
1263 case TGENINDEX:
1264 *t++ = AC.DumNum + WILDOFFSET;
1265 break;
1266 case TVECTOR:
1267 if ( inset < 2 ) *t++ = x2 + AM.OffsetVector;
1268 else *t++ = x2;
1269 break;
1270 case TWILDARG:
1271 *t++ = FUNNYWILD; *t++ = x2;
1272/* v[2] = 0; */
1273 break;
1274 case TDOLLAR:
1275 *t++ = FUNNYDOLLAR; *t++ = x2;
1276 break;
1277 case TDUBIOUS:
1278 if ( inset < 2 ) *t++ = x2 + AM.OffsetVector;
1279 else *t++ = x2;
1280 break;
1281 case TSGAMMA: /* Special gamma's */
1282 if ( x3 != GAMMA ) {
1283 MesPrint("&5_,6_,7_ can only be used inside g_");
1284 error = -1;
1285 }
1286 *t++ = -x2;
1287 break;
1288 case TNUMBER:
1289 case TNUMBER1:
1290 if ( x2 >= AM.OffsetIndex && inset < 2 ) {
1291 MesPrint("&Value of constant index in tensor too large");
1292 error = -1;
1293 }
1294 *t++ = x2;
1295 break;
1296 default:
1297 MesPrint("&Illegal object in tensor");
1298 error = -1;
1299 break;
1300 }}
1301 if ( inset >= 2 ) inset = 1;
1302 } while ( *s == TCOMMA );
1303 }
1304 else {
1305dofunction: firstsumarg = 1;
1306 do {
1307 unsigned int ux2;
1308 s++;
1309 c = *s++;
1310 if ( c == TMINUS && ( *s == TVECTOR || *s == TNUMBER
1311 || *s == TNUMBER1 || *s == TSUBEXP ) ) {
1312 minus = 1; c = *s++;
1313 }
1314 else minus = 0;
1315 base = ( c == TNUMBER ) ? 100: 128;
1316 ux2 = 0; while ( *s >= 0 ) { ux2 = base*ux2 + *s++; }
1317 x2 = ux2; /* may cause an implementation-defined behaviour */
1318/*
1319 !!!!!!!! What if it does not fit?
1320*/
1321 if ( firstsumarg ) {
1322 firstsumarg = 0;
1323 if ( sumlevel > 0 ) {
1324 if ( c == TSYMBOL ) {
1325 sumlevel = x2; sumtype = SYMTOSYM;
1326 }
1327 else if ( c == TINDEX ) {
1328 sumlevel = x2+AM.OffsetIndex; sumtype = INDTOIND;
1329 if ( sumlevel > AM.IndDum ) {
1330 x2 = sumlevel - AM.IndDum;
1331 if ( x2 > C->numdum[numexp] ) C->numdum[numexp] = x2;
1332 }
1333 }
1334 }
1335 }
1336 if ( *s == TWILDCARD ) {
1337 if ( c == TSYMBOL ) x2 += 2*MAXPOWER;
1338 else if ( c != TNUMBER ) x2 += WILDOFFSET;
1339 s++;
1340 }
1341 switch ( c ) {
1342 case TSYMBOL:
1343 *t++ = -SYMBOL; *t++ = x2; break;
1344 case TDOLLAR:
1345 *t++ = -DOLLAREXPRESSION; *t++ = x2; break;
1346 case TEXPRESSION:
1347 *t++ = -EXPRESSION; *t++ = x2;
1348/*
1349 The next code is added to facilitate parallel processing
1350 We need to call GetTable here to make sure all processors
1351 have the same numbering of all variables.
1352*/
1353 if ( Expressions[x2].status == STOREDEXPRESSION ) {
1354 TMproto[0] = EXPRESSION;
1355 TMproto[1] = SUBEXPSIZE;
1356 TMproto[2] = x2;
1357 TMproto[3] = 1;
1358 { int ie; for ( ie = 4; ie < SUBEXPSIZE; ie++ ) TMproto[ie] = 0; }
1359 AT.TMaddr = TMproto;
1360 PUTZERO(position);
1361/*
1362 if ( (
1363#ifdef WITHPTHREADS
1364 renumber =
1365#endif
1366 GetTable(x2,&position,0) ) == 0 ) {
1367 error = 1;
1368 MesPrint("&Problems getting information about stored expression %s(2)"
1369 ,EXPRNAME(x2));
1370 }
1371#ifdef WITHPTHREADS
1372 M_free(renumber->symb.lo,"VarSpace");
1373 M_free(renumber,"Renumber");
1374#endif
1375*/
1376 if ( ( renumber = GetTable(x2,&position,0) ) == 0 ) {
1377/* INTERNAL_ERROR_EXCL_START */
1378 error = 1;
1379 MesPrint("!>Problems getting information about stored expression %s(2)"
1380 ,EXPRNAME(x2));
1381/* INTERNAL_ERROR_EXCL_STOP */
1382 }
1383 if ( renumber->symb.lo != AN.dummyrenumlist )
1384 M_free(renumber->symb.lo,"VarSpace");
1385 M_free(renumber,"Renumber");
1386 AR.StoreData.dirtyflag = 1;
1387 }
1388 break;
1389 case TINDEX:
1390 *t++ = -INDEX; *t++ = x2 + AM.OffsetIndex;
1391 if ( t[-1] > AM.IndDum ) {
1392 x2 = t[-1] - AM.IndDum;
1393 if ( x2 > C->numdum[numexp] ) C->numdum[numexp] = x2;
1394 }
1395 break;
1396 case TGENINDEX:
1397 *t++ = -INDEX; *t++ = AC.DumNum + WILDOFFSET;
1398 break;
1399 case TVECTOR:
1400 if ( minus ) *t++ = -MINVECTOR;
1401 else *t++ = -VECTOR;
1402 *t++ = x2 + AM.OffsetVector;
1403 break;
1404 case TSGAMMA: /* Special gamma's */
1405 MesPrint("&5_,6_,7_ can only be used inside g_");
1406 error = -1;
1407 *t++ = -INDEX;
1408 *t++ = -x2;
1409 break;
1410 case TDUBIOUS:
1411 *t++ = -SYMBOL; *t++ = x2; break;
1412 case TFUNCTION:
1413 *t++ = -x2-FUNCTION;
1414 break;
1415 case TSET:
1416 *t++ = -SETSET;
1417 *t++ = x2;
1418 break;
1419 case TWILDARG:
1420 *t++ = -ARGWILD; *t++ = x2; break;
1421 case TSETDOL:
1422 x2 = -x2;
1423 /* fall through */
1424 case TSETNUM:
1425 if ( inset == 0 ) {
1426 w1 = t; t += 2; w2 = t;
1427 while ( w1 > v ) *--w2 = *--w1;
1428 tsize = v; relo = AT.WorkTop;
1429 *v++ = SETSET; *v++ = 0;
1430 inset = 1;
1431 }
1432 *--relo = x2; *--relo = t-v+1;
1433 c = *s++;
1434 x2 = 0; while ( *s >= 0 ) x2 = 128*x2 + *s++;
1435 switch ( c ) {
1436 case TFUNCTION:
1437 (*relo)--; *t++ = -x2-1; break;
1438 case TSYMBOL:
1439 *t++ = -SYMBOL; *t++ = x2; break;
1440 case TINDEX:
1441 *t++ = -INDEX; *t++ = x2;
1442 if ( x2+AM.OffsetIndex > AM.IndDum ) {
1443 x2 = x2+AM.OffsetIndex - AM.IndDum;
1444 if ( x2 > C->numdum[numexp] ) C->numdum[numexp] = x2;
1445 }
1446 break;
1447 case TVECTOR:
1448 *t++ = -VECTOR; *t++ = x2; break;
1449 case TNUMBER1:
1450 *t++ = -SNUMBER; *t++ = x2; break;
1451 default:
1452/* INTERNAL_ERROR_EXCL_START */
1453 MesPrint("!>Internal error 435");
1454 error = 1;
1455 *t++ = -SYMBOL; *t++ = x2; break;
1456/* INTERNAL_ERROR_EXCL_STOP */
1457 }
1458 break;
1459 case TSUBEXP:
1460 w2 = AC.ProtoType; i = w2[1];
1461 w1 = t;
1462 *t++ = i+ARGHEAD+4;
1463 *t++ = 1;
1464 FILLARG(t);
1465 *t++ = i + 4;
1466 while ( --i >= 0 ) *t++ = *w2++;
1467 w1[ARGHEAD+3] = subexpbuffers[x2].subexpnum;
1468 w1[ARGHEAD+5] = subexpbuffers[x2].buffernum;
1469 if ( sumlevel > 0 ) {
1470 w1[0] += 4;
1471 w1[ARGHEAD] += 4;
1472 w1[ARGHEAD+2] += 4;
1473 *t++ = sumtype; *t++ = 4;
1474 *t++ = sumlevel; *t++ = sumlevel;
1475 }
1476 *t++ = 1; *t++ = 1;
1477 if ( minus ) *t++ = -3;
1478 else *t++ = 3;
1479 break;
1480 case TNUMBER:
1481 case TNUMBER1:
1482 if ( minus ) x2 = UnsignedToInt(-IntAbs(x2));
1483 *t++ = -SNUMBER;
1484 *t++ = x2;
1485 break;
1486 default:
1487 MesPrint("&Illegal object in function");
1488 error = -1;
1489 break;
1490 }
1491 } while ( *s == TCOMMA );
1492 }
1493 if ( *s != TFUNCLOSE ) {
1494 MesPrint("&Illegal argument field for function. Expected )");
1495 return(-1);
1496 }
1497 s++; sumlevel = 0;
1498 v[1] = t-v;
1499/*
1500 if ( *v == AM.termfunnum && ( v[1] != FUNHEAD+2 ||
1501 v[FUNHEAD] != -DOLLAREXPRESSION ) ) {
1502 MesPrint("&The function term_ can only have one argument with a single $-expression");
1503 error = 1;
1504 }
1505*/
1506 goto fin;
1507 case TDUBIOUS:
1508 x1 = 0; while ( *s >= 0 ) x1 = 128*x1 + *s++;
1509 if ( *s == TWILDCARD ) s++;
1510 if ( *s == TDOT ) goto dovector;
1511 if ( *s == TFUNOPEN ) {
1512 x1 += FUNCTION;
1513 cc = 1;
1514 v = t; *t++ = x1; *t++ = FUNHEAD; *t++ = DIRTYFLAG;
1515 if ( x1 == AR.PolyFun && AR.PolyFunType == 2 && AR.Eside != LHSIDE )
1516 t[-1] |= MUSTCLEANPRF;
1517 FILLFUN3(t)
1518 needarg = -1; goto dofunction;
1519 }
1520 *t++ = SYMBOL; *t++ = 4; *t++ = 0;
1521 if ( inset ) *relo = 2;
1522 goto TryPower;
1523 case TSUBEXP:
1524 x1 = 0; while ( *s >= 0 ) { x1 = x1*128 + *s++; }
1525 if ( *s == TPOWER ) {
1526 s++; c = *s++;
1527 base = ( c == TNUMBER ) ? 100: 128;
1528 x2 = 0; while ( *s >= 0 ) { x2 = base*x2 + *s++; }
1529 if ( *s == TWILDCARD ) { x2 += 2*MAXPOWER; s++; }
1530 else if ( c == TSYMBOL ) x2 += 2*MAXPOWER;
1531 }
1532 else x2 = 1;
1533 r = AC.ProtoType; n = r[1] - 5; r += 5;
1534 *t++ = SUBEXPRESSION; *t++ = r[-4];
1535 *t++ = subexpbuffers[x1].subexpnum;
1536 *t++ = x2*deno;
1537 *t++ = subexpbuffers[x1].buffernum;
1538 NCOPY(t,r,n);
1539 if ( cbuf[subexpbuffers[x1].buffernum].CanCommu[subexpbuffers[x1].subexpnum] ) cc = 1;
1540 deno = 1;
1541 break;
1542 case TMULTIPLY:
1543 mulflag = 1;
1544 break;
1545 case TDIVIDE:
1546 mulflag = 1;
1547 deno = -deno;
1548 break;
1549 case TEXPRESSION:
1550 cc = 1;
1551 x1 = 0; while ( *s >= 0 ) { x1 = x1*128 + *s++; }
1552 v = t;
1553 *t++ = EXPRESSION; *t++ = SUBEXPSIZE; *t++ = x1; *t++ = deno;
1554 *t++ = 0; FILLSUB(t)
1555/*
1556 Here we had some erroneous code before. It should be after
1557 the reading of the parameters as it is now (after 15-jan-2007).
1558 Thomas Hahn noticed this and reported it.
1559*/
1560 if ( *s == TFUNOPEN ) {
1561 do {
1562 s++; c = *s++;
1563 base = ( c == TNUMBER ) ? 100: 128;
1564 x2 = 0; while ( *s >= 0 ) { x2 = base*x2 + *s++; }
1565 switch ( c ) {
1566 case TSYMBOL:
1567 *t++ = SYMBOL; *t++ = 4; *t++ = x2; *t++ = 1;
1568 break;
1569 case TINDEX:
1570 *t++ = INDEX; *t++ = 3; *t++ = x2+AM.OffsetIndex;
1571 if ( t[-1] > AM.IndDum ) {
1572 x2 = t[-1] - AM.IndDum;
1573 if ( x2 > C->numdum[numexp] ) C->numdum[numexp] = x2;
1574 }
1575 break;
1576 case TVECTOR:
1577 *t++ = INDEX; *t++ = 3; *t++ = x2+AM.OffsetVector;
1578 break;
1579 case TFUNCTION:
1580 *t++ = x2+FUNCTION; *t++ = 2; break;
1581 case TNUMBER:
1582 case TNUMBER1:
1583 if ( x2 >= AM.OffsetIndex || x2 < 0 ) {
1584 MesPrint("&Index as argument of expression has illegal value");
1585 error = -1;
1586 }
1587 *t++ = INDEX; *t++ = 3; *t++ = x2; break;
1588 case TSETDOL:
1589 x2 = -x2;
1590 /* fall through */
1591 case TSETNUM:
1592 if ( inset == 0 ) {
1593 w1 = t; t += 2; w2 = t;
1594 while ( w1 > v ) *--w2 = *--w1;
1595 tsize = v; relo = AT.WorkTop;
1596 *v++ = SETSET; *v++ = 0;
1597 inset = 1;
1598 }
1599 *--relo = x2; *--relo = t-v+2;
1600 c = *s++;
1601 x2 = 0; while ( *s >= 0 ) x2 = 128*x2 + *s++;
1602 switch ( c ) {
1603 case TFUNCTION:
1604 *relo -= 2; *t++ = -x2-1; break;
1605 case TSYMBOL:
1606 *t++ = SYMBOL; *t++ = 4; *t++ = x2; *t++ = 1; break;
1607 case TINDEX:
1608 *t++ = INDEX; *t++ = 3; *t++ = x2;
1609 if ( x2+AM.OffsetIndex > AM.IndDum ) {
1610 x2 = x2+AM.OffsetIndex - AM.IndDum;
1611 if ( x2 > C->numdum[numexp] ) C->numdum[numexp] = x2;
1612 }
1613 break;
1614 case TVECTOR:
1615 *t++ = VECTOR; *t++ = 3; *t++ = x2; break;
1616 case TNUMBER1:
1617 *t++ = SNUMBER; *t++ = 4; *t++ = x2; *t++ = 1; break;
1618 default:
1619/* INTERNAL_ERROR_EXCL_START */
1620 MesPrint("!>Internal error 435");
1621 error = 1;
1622 *t++ = SYMBOL; *t++ = 4; *t++ = x2; *t++ = 1; break;
1623/* INTERNAL_ERROR_EXCL_STOP */
1624 }
1625 break;
1626 default:
1627 MesPrint("&Argument of expression can only be symbol, index, vector or function");
1628 error = -1;
1629 break;
1630 }
1631 } while ( *s == TCOMMA );
1632 if ( *s != TFUNCLOSE ) {
1633 MesPrint("&Illegal object in argument field for expression");
1634 error = -1;
1635 while ( *s != TFUNCLOSE ) s++;
1636 }
1637 s++;
1638 }
1639 r = AC.ProtoType; n = r[1];
1640 if ( n > SUBEXPSIZE ) {
1641 *t++ = WILDCARDS; *t++ = n+2;
1642 NCOPY(t,r,n);
1643 }
1644/*
1645 Code added for parallel processing.
1646 This is different from the other occurrences to test immediately
1647 for renumbering. Here we have to read the parameters first.
1648*/
1649 if ( Expressions[x1].status == STOREDEXPRESSION ) {
1650 v[1] = t-v;
1651 AT.TMaddr = v;
1652 PUTZERO(position);
1653/*
1654 if ( (
1655#ifdef WITHPTHREADS
1656 renumber =
1657#endif
1658 GetTable(x1,&position,0) ) == 0 ) {
1659 error = 1;
1660 MesPrint("&Problems getting information about stored expression %s(3)"
1661 ,EXPRNAME(x1));
1662 }
1663#ifdef WITHPTHREADS
1664 M_free(renumber->symb.lo,"VarSpace");
1665 M_free(renumber,"Renumber");
1666#endif
1667*/
1668 if ( ( renumber = GetTable(x1,&position,0) ) == 0 ) {
1669/* INTERNAL_ERROR_EXCL_START */
1670 error = 1;
1671 MesPrint("!>Problems getting information about stored expression %s(3)"
1672 ,EXPRNAME(x1));
1673/* INTERNAL_ERROR_EXCL_STOP */
1674 }
1675 if ( renumber->symb.lo != AN.dummyrenumlist )
1676 M_free(renumber->symb.lo,"VarSpace");
1677 M_free(renumber,"Renumber");
1678 AR.StoreData.dirtyflag = 1;
1679 }
1680 if ( *s == LBRACE ) {
1681/*
1682 This should be one term that should be inserted
1683 FROMBRAC size+2 ( term )
1684 Because this term should have been translated
1685 already we can copy it from the 'subexpression'
1686*/
1687 s++;
1688 if ( *s != TSUBEXP ) {
1689/* INTERNAL_ERROR_EXCL_START */
1690 MesPrint("!>Internal error 23");
1691 Terminate(-1);
1692/* INTERNAL_ERROR_EXCL_STOP */
1693 }
1694 s++; x2 = 0; while ( *s >= 0 ) { x2 = 128*x2 + *s++; }
1695 r = cbuf[subexpbuffers[x2].buffernum].rhs[subexpbuffers[x2].subexpnum];
1696 *t++ = FROMBRAC; *t++ = *r+2;
1697 n = *r;
1698 NCOPY(t,r,n);
1699 if ( *r != 0 ) {
1700 MesPrint("&Object between [] in expression should be a single term");
1701 error = -1;
1702 }
1703 if ( *s != RBRACE ) {
1704/* INTERNAL_ERROR_EXCL_START */
1705 MesPrint("!>Internal error 23b");
1706 Terminate(-1);
1707/* INTERNAL_ERROR_EXCL_STOP */
1708 }
1709 s++;
1710 }
1711 if ( *s == TPOWER ) {
1712 s++; c = *s++;
1713 base = ( c == TNUMBER ) ? 100: 128;
1714 x2 = 0; while ( *s >= 0 ) { x2 = base*x2 + *s++; }
1715 if ( *s == TWILDCARD || c == TSYMBOL ) { x2 += 2*MAXPOWER; s++; }
1716 v[3] = x2;
1717 }
1718 v[1] = t - v;
1719 deno = 1;
1720 break;
1721 case TNUMBER:
1722 if ( *s == 0 ) {
1723 s++;
1724 if ( *s == TPOWER ) {
1725 s++; if ( *s == TMINUS ) { s++; deno = -deno; }
1726 c = *s++; base = ( c == TNUMBER ) ? 100: 128;
1727 x2 = 0; while ( *s >= 0 ) { x2 = x2*base + *s++; }
1728 if ( x2 == 0 ) {
1729 error = -1;
1730 MesPrint("&Encountered 0^0 during compilation");
1731 }
1732 if ( deno < 0 ) {
1733 error = -1;
1734 MesPrint("&Division by zero during compilation (0 to the power negative number)");
1735 }
1736 }
1737 else if ( deno < 0 ) {
1738 error = -1;
1739 MesPrint("&Division by zero during compilation");
1740 }
1741 sign = 0; break; /* term is zero */
1742 }
1743 y = *s++;
1744 if ( *s >= 0 ) { y = 100*y + *s++; }
1745 innum[0] = y; nin = 1;
1746 while ( *s >= 0 ) {
1747 y = *s++; x2 = 100;
1748 if ( *s >= 0 ) { y = 100*y + *s++; x2 = 10000; }
1749 Product(innum,&nin,(WORD)x2);
1750 if ( y ) AddLong(innum,nin,(UWORD *)(&y),(WORD)1,innum,&nin);
1751 }
1752docoef:
1753 if ( *s == TPOWER ) {
1754 s++; if ( *s == TMINUS ) { s++; deno = -deno; }
1755 c = *s++; base = ( c == TNUMBER ) ? 100: 128;
1756 x2 = 0; while ( *s >= 0 ) { x2 = x2*base + *s++; }
1757 if ( x2 == 0 ) {
1758 innum[0] = 1; nin = 1;
1759 }
1760 else if ( RaisPow(BHEAD innum,&nin,x2) ) {
1761 error = -1; innum[0] = 1; nin = 1;
1762 }
1763 }
1764 if ( deno > 0 ) {
1765 Simplify(BHEAD innum,&nin,denominator,&ndenominator);
1766 for ( i = 0; i < nnumerator; i++ ) CGscrat7[i] = numerator[i];
1767 MulLong(innum,nin,CGscrat7,nnumerator,numerator,&nnumerator);
1768 }
1769 else if ( deno < 0 ) {
1770 Simplify(BHEAD innum,&nin,numerator,&nnumerator);
1771 for ( i = 0; i < ndenominator; i++ ) CGscrat7[i] = denominator[i];
1772 MulLong(innum,nin,CGscrat7,ndenominator,denominator,&ndenominator);
1773 }
1774 deno = 1;
1775 break;
1776 case TNUMBER1:
1777 if ( *s == 0 ) { s++; sign = 0; break; /* term is zero */ }
1778 y = *s++;
1779 if ( *s >= 0 ) { y = 128*y + *s++; }
1780 if ( inset == 0 ) {
1781 innum[0] = y; nin = 1;
1782 while ( *s >= 0 ) {
1783 y = *s++; x2 = 128;
1784 if ( *s >= 0 ) { y = 128*y + *s++; x2 = 16384; }
1785 Product(innum,&nin,(WORD)x2);
1786 if ( y ) AddLong(innum,nin,(UWORD *)&y,(WORD)1,innum,&nin);
1787 }
1788 goto docoef;
1789 }
1790 *relo = 2; *t++ = SNUMBER; *t++ = 4; *t++ = y;
1791 goto TryPower;
1792#ifdef WITHFLOAT
1793 case TFLOAT:
1794 { WORD *w;
1795 s = ReadFloat(s);
1796 i = AT.WorkPointer[1];
1797 w = AT.WorkPointer;
1798 NCOPY(t,w,i);
1799/*
1800Power?
1801*/
1802 }
1803 break;
1804#endif
1805 case TDOLLAR:
1806 {
1807 WORD *powplace;
1808 x1 = 0; while ( *s >= 0 ) { x1 = x1*128 + *s++; }
1809 if ( AR.Eside != LHSIDE ) {
1810 *t++ = SUBEXPRESSION; *t++ = SUBEXPSIZE; *t++ = x1;
1811 }
1812 else {
1813 *t++ = DOLLAREXPRESSION; *t++ = SUBEXPSIZE; *t++ = x1;
1814 }
1815 powplace = t; t++;
1816 *t++ = AM.dbufnum; FILLSUB(t)
1817/*
1818 Now we have to test for factors of dollars with [ ] and [ [ ]]
1819*/
1820 if ( *s == LBRACE ) {
1821 int bracelevel = 1;
1822 s++;
1823 while ( bracelevel > 0 ) {
1824 if ( *s == RBRACE ) {
1825 bracelevel--; s++;
1826 }
1827 else if ( *s == TNUMBER ) {
1828 s++;
1829 x2 = 0; while ( *s >= 0 ) { x2 = 100*x2 + *s++; }
1830 *t++ = DOLLAREXPR2; *t++ = 3; *t++ = -x2-1;
1831CloseBraces:
1832 while ( bracelevel > 0 ) {
1833 if ( *s != RBRACE ) {
1834ErrorBraces:
1835 error = -1;
1836 MesPrint("&Improper use of [] in $-variable.");
1837 return(error);
1838 }
1839 else {
1840 s++; bracelevel--;
1841 }
1842 }
1843 }
1844 else if ( *s == TDOLLAR ) {
1845 s++;
1846 x1 = 0; while ( *s >= 0 ) { x1 = x1*128 + *s++; }
1847 *t++ = DOLLAREXPR2; *t++ = 3; *t++ = x1;
1848 if ( *s == RBRACE ) goto CloseBraces;
1849 else if ( *s == LBRACE ) {
1850 s++; bracelevel++;
1851 }
1852 }
1853 else goto ErrorBraces;
1854 }
1855 }
1856/*
1857 Finally we can continue with the power
1858*/
1859 if ( *s == TPOWER ) {
1860 s++;
1861 if ( *s == TMINUS ) { s++; deno = -deno; }
1862 c = *s++;
1863 base = ( c == TNUMBER ) ? 100: 128;
1864 x2 = 0; while ( *s >= 0 ) { x2 = base*x2 + *s++; }
1865 if ( c == TSYMBOL ) {
1866 if ( *s == TWILDCARD ) s++;
1867 x2 += 2*MAXPOWER;
1868 }
1869 *powplace = deno*x2;
1870 }
1871 else *powplace = deno;
1872 deno = 1;
1873/*
1874 if ( inset ) {
1875 while ( relo < AT.WorkTop ) *t++ = *relo++;
1876 inset = 0; tsize[1] = t - tsize;
1877 }
1878*/
1879 }
1880 break;
1881 case TSETNUM:
1882 inset = 1; tsize = t; relo = AT.WorkTop;
1883 *t++ = SETSET; *t++ = 0;
1884 x1 = 0; while ( *s >= 0 ) x1 = x1*128 + *s++;
1885 *--relo = x1; *--relo = 0;
1886 break;
1887 case TSETDOL:
1888 inset = 1; tsize = t; relo = AT.WorkTop;
1889 *t++ = SETSET; *t++ = 0;
1890 x1 = 0; while ( *s >= 0 ) x1 = x1*128 + *s++;
1891 *--relo = -x1; *--relo = 0;
1892 break;
1893 case TFUNOPEN:
1894 MesPrint("&Illegal use of function arguments");
1895 error = -1;
1896 funflag = 1;
1897 deno = 1;
1898 break;
1899 case TFUNCLOSE:
1900 if ( funflag == 0 )
1901 MesPrint("&Illegal use of function arguments");
1902 error = -1;
1903 funflag = 0;
1904 deno = 1;
1905 break;
1906 case TSGAMMA:
1907 MesPrint("&Illegal use special gamma symbols 5_, 6_, 7_");
1908 error = -1;
1909 funflag = 0;
1910 deno = 1;
1911 break;
1912 case TCONJUGATE:
1913 MesPrint("&Complex conjugate operator (%#) is not implemented");
1914 error = -1;
1915 deno = 1;
1916 break;
1917 default:
1918 MesPrint("&Internal error in code generator. Unknown object: %d",c);
1919 error = -1;
1920 deno = 1;
1921 break;
1922 }
1923 }
1924 }
1925 if ( mulflag ) {
1926 MesPrint("&Irregular end of statement.");
1927 error = 1;
1928 }
1929 if ( !first && error == 0 ) {
1930 *term = t-term;
1931 C->NumTerms[numexp]++;
1932 if ( cc && sign ) C->CanCommu[numexp]++;
1933 error = CompleteTerm(term,numerator,denominator,nnumerator,ndenominator,sign);
1934 }
1935 AT.WorkPointer = oldwork;
1936 if ( error ) return(-1);
1937 AddToCB(C,0)
1938 if ( AC.CompileLevel > 0 && AR.Eside != LHSIDE ) {
1939 /* See whether we have this one already */
1940 error = InsTree(AC.cbufnum,C->numrhs);
1941 if ( error < (C->numrhs) ) {
1942 C->Pointer = C->rhs[C->numrhs--];
1943 return(error);
1944 }
1945 }
1946 return(C->numrhs);
1947OverWork:
1948 MLOCK(ErrorMessageLock);
1949 MesWork();
1950 MUNLOCK(ErrorMessageLock);
1951 return(-1);
1952}
1953
1954/*
1955 #] CodeGenerator :
1956 #[ CompleteTerm :
1957
1958 Completes the term
1959 Puts it in the buffer
1960*/
1961
1962int CompleteTerm(WORD *term, UWORD *numer, UWORD *denom, WORD nnum, WORD nden, int sign)
1963{
1964 int nsize, i;
1965 WORD *t;
1966 if ( sign == 0 ) return(0); /* Term is zero */
1967 if ( nnum >= nden ) nsize = nnum;
1968 else nsize = nden;
1969 t = term + *term;
1970 for ( i = 0; i < nnum; i++ ) *t++ = numer[i];
1971 for ( ; i < nsize; i++ ) *t++ = 0;
1972 for ( i = 0; i < nden; i++ ) *t++ = denom[i];
1973 for ( ; i < nsize; i++ ) *t++ = 0;
1974 *t++ = (2*nsize+1)*sign;
1975 *term = t - term;
1976 AddNtoC(AC.cbufnum,*term,term,7);
1977 return(0);
1978}
1979
1980/*
1981 #] CompleteTerm :
1982 #[ CodeFactors :
1983
1984 This routine does the part of reading in in terms of factors.
1985 If there is more than one term at this level we have only one
1986 factor. In that case any expression should first be unfactorized.
1987 Then the whole expression gets read as a new subexpression and finally
1988 we generate factor_*subexpression.
1989 If the whole has only multiplications we have factors. Then the
1990 nasty thing is powers of objects and in particular powers of
1991 factorized expressions or dollars.
1992 For a power we generate a new subexpression of the type
1993 1+factor_+...+factor_^(power-1)
1994 with which we multiply.
1995
1996 WE HAVE NOT YET WORRIED ABOUT SETS
1997*/
1998
1999int CodeFactors(SBYTE *tokens)
2000{
2001 GETIDENTITY
2002 EXPRESSIONS e = Expressions + AR.CurExpr;
2003 int nfactor = 1, nparenthesis, i, last = 0, error = 0;
2004 SBYTE *t, *startobject, *tt, *s1, *out, *outtokens;
2005 WORD nexp, subexp = 0, power, pow, x2, powfactor, first;
2006/*
2007 First scan the number of factors
2008*/
2009 t = tokens;
2010 while ( *t != TENDOFIT ) {
2011 if ( *t >= 0 ) { while ( *t >= 0 ) t++; continue; }
2012 if ( *t == LPARENTHESIS || *t == LBRACE || *t == TSETOPEN || *t == TFUNOPEN ) {
2013 nparenthesis = 0; t++;
2014 while ( nparenthesis >= 0 ) {
2015 if ( *t == LPARENTHESIS || *t == LBRACE || *t == TSETOPEN || *t == TFUNOPEN ) nparenthesis++;
2016 else if ( *t == RPARENTHESIS || *t == RBRACE || *t == TSETCLOSE || *t == TFUNCLOSE ) nparenthesis--;
2017 t++;
2018 }
2019 continue;
2020 }
2021 else if ( ( *t == TPLUS || *t == TMINUS ) && ( t > tokens )
2022 && ( t[-1] != TPLUS && t[-1] != TMINUS ) ) {
2023 if ( t[-1] >= 0 || t[-1] == RPARENTHESIS || t[-1] == RBRACE
2024 || t[-1] == TSETCLOSE || t[-1] == TFUNCLOSE ) {
2025 subexp = CodeGenerator(tokens);
2026 if ( subexp < 0 ) error = -1;
2027 if ( insubexpbuffers >= MAXSUBEXPRESSIONS ) {
2028 MesPrint("&More than %d subexpressions inside one expression",(WORD)MAXSUBEXPRESSIONS);
2029 Terminate(-1);
2030 }
2031 if ( subexpbuffers+insubexpbuffers >= topsubexpbuffers ) {
2032 DoubleBuffer((void **)((void *)(&subexpbuffers))
2033 ,(void **)((void *)(&topsubexpbuffers)),sizeof(SUBBUF),"subexpbuffers");
2034 }
2035 subexpbuffers[insubexpbuffers].subexpnum = subexp;
2036 subexpbuffers[insubexpbuffers].buffernum = AC.cbufnum;
2037 subexp = insubexpbuffers++;
2038 t = tokens;
2039 *t++ = TSYMBOL; *t++ = FACTORSYMBOL;
2040 *t++ = TMULTIPLY; *t++ = TSUBEXP;
2041 PUTNUMBER128(t,subexp)
2042 *t++ = TENDOFIT;
2043 e->numfactors = 1;
2044 e->vflags |= ISFACTORIZED;
2045 return(subexp);
2046 }
2047 }
2048 else if ( ( *t == TMULTIPLY || *t == TDIVIDE ) && t > tokens ) {
2049 nfactor++;
2050 }
2051 else if ( *t == TEXPRESSION ) {
2052 t++;
2053 nexp = 0; while ( *t >= 0 ) { nexp = nexp*128 + *t++; }
2054 if ( *t == LBRACE ) continue;
2055 if ( ( AS.Oldvflags[nexp] & ISFACTORIZED ) != 0 ) {
2056 nfactor += AS.OldNumFactors[nexp];
2057 }
2058 else { nfactor++; }
2059 continue;
2060 }
2061 else if ( *t == TDOLLAR ) {
2062 t++;
2063 nexp = 0; while ( *t >= 0 ) { nexp = nexp*128 + *t++; }
2064 if ( *t == LBRACE ) continue;
2065 if ( Dollars[nexp].nfactors > 0 ) {
2066 nfactor += Dollars[nexp].nfactors;
2067 }
2068 else { nfactor++; }
2069 continue;
2070 }
2071 t++;
2072 }
2073/*
2074 Now the real pass.
2075 nfactor is a not so reliable measure for the space we need.
2076*/
2077 outtokens = (SBYTE *)Malloc1(((t-tokens)+(nfactor+2)*25)*sizeof(SBYTE),"CodeFactors");
2078 out = outtokens;
2079 t = tokens; first = 1; powfactor = 1;
2080 while ( *t == TPLUS || *t == TMINUS ) { if ( *t == TMINUS ) first = -first; t++; }
2081 if ( first < 0 ) {
2082 *out++ = TMINUS; *out++ = TSYMBOL; *out++ = FACTORSYMBOL;
2083 *out++ = TPOWER; *out++ = TNUMBER; PUTNUMBER100(out,powfactor)
2084 powfactor++;
2085 }
2086 startobject = t; power = 1;
2087 while ( *t != TENDOFIT ) {
2088 if ( *t >= 0 ) { while ( *t >= 0 ) t++; continue; }
2089 if ( *t == LPARENTHESIS || *t == LBRACE || *t == TSETOPEN || *t == TFUNOPEN ) {
2090 nparenthesis = 0; t++;
2091 while ( nparenthesis >= 0 ) {
2092 if ( *t == LPARENTHESIS || *t == LBRACE || *t == TSETOPEN || *t == TFUNOPEN ) nparenthesis++;
2093 else if ( *t == RPARENTHESIS || *t == RBRACE || *t == TSETCLOSE || *t == TFUNCLOSE ) nparenthesis--;
2094 t++;
2095 }
2096 continue;
2097 }
2098 else if ( ( *t == TMULTIPLY || *t == TDIVIDE ) && ( t > tokens ) ) {
2099 if ( t[-1] >= 0 || t[-1] == RPARENTHESIS || t[-1] == RBRACE
2100 || t[-1] == TSETCLOSE || t[-1] == TFUNCLOSE ) {
2101dolast:
2102 if ( startobject ) { /* apparently power is 1 or -1 */
2103 *out++ = TPLUS;
2104 if ( power < 0 ) { *out++ = TNUMBER; *out++ = 1; *out++ = TDIVIDE; }
2105 s1 = startobject;
2106 while ( s1 < t ) *out++ = *s1++;
2107 *out++ = TMULTIPLY; *out++ = TSYMBOL; *out++ = FACTORSYMBOL;
2108 *out++ = TPOWER; *out++ = TNUMBER; PUTNUMBER100(out,powfactor)
2109 powfactor++;
2110 }
2111 if ( last ) { startobject = 0; break; }
2112 startobject = t+1;
2113 if ( *t == TDIVIDE ) power = -1;
2114 if ( *t == TMULTIPLY ) power = 1;
2115 }
2116 }
2117 else if ( *t == TPOWER ) {
2118 pow = 1;
2119 tt = t+1;
2120 while ( ( *tt == TMINUS ) || ( *tt == TPLUS ) ) {
2121 if ( *tt == TMINUS ) pow = -pow;
2122 tt++;
2123 }
2124 if ( *tt == TSYMBOL ) {
2125 tt++; while ( *tt >= 0 ) tt++;
2126 t = tt; continue;
2127 }
2128 tt++; x2 = 0; while ( *tt >= 0 ) { x2 = 100*x2 + *tt++; }
2129/*
2130 We have an object in startobject till t. The power is
2131 power*pow*x2
2132*/
2133 power = power*pow*x2;
2134 if ( power < 0 ) { pow = -power; power = -1; }
2135 else if ( power == 0 ) { t = tt; startobject = tt; continue; }
2136 else { pow = power; power = 1; }
2137 *out++ = TPLUS;
2138 if ( pow > 1 ) {
2139 subexp = GenerateFactors(pow,1);
2140 if ( subexp < 0 ) { error = -1; subexp = 0; }
2141 *out++ = TSUBEXP; PUTNUMBER128(out,subexp);
2142 }
2143 *out++ = TSYMBOL; *out++ = FACTORSYMBOL;
2144 *out++ = TPOWER; *out++ = TNUMBER; PUTNUMBER100(out,powfactor)
2145 powfactor += pow;
2146 if ( power > 0 ) *out++ = TMULTIPLY;
2147 else *out++ = TDIVIDE;
2148 s1 = startobject; while ( s1 < t ) *out++ = *s1++;
2149 startobject = 0; t = tt; continue;
2150 }
2151 else if ( *t == TEXPRESSION ) {
2152 startobject = t;
2153 t++;
2154 nexp = 0; while ( *t >= 0 ) { nexp = nexp*128 + *t++; }
2155 if ( *t == LBRACE ) continue;
2156 if ( *t == LPARENTHESIS ) {
2157 nparenthesis = 0; t++;
2158 while ( nparenthesis >= 0 ) {
2159 if ( *t == LPARENTHESIS ) nparenthesis++;
2160 else if ( *t == RPARENTHESIS ) nparenthesis--;
2161 t++;
2162 }
2163 }
2164 if ( ( AS.Oldvflags[nexp] & ISFACTORIZED ) == 0 ) continue;
2165 if ( *t == TPOWER ) {
2166 pow = 1;
2167 tt = t+1;
2168 while ( ( *tt == TMINUS ) || ( *tt == TPLUS ) ) {
2169 if ( *tt == TMINUS ) pow = -pow;
2170 tt++;
2171 }
2172 if ( *tt != TNUMBER ) {
2173/* INTERNAL_ERROR_EXCL_START */
2174 MesPrint("!>Internal problems(1) in CodeFactors");
2175 return(-1);
2176/* INTERNAL_ERROR_EXCL_STOP */
2177 }
2178 tt++; x2 = 0; while ( *tt >= 0 ) { x2 = 100*x2 + *tt++; }
2179/*
2180 We have an object in startobject till t. The power is
2181 power*pow*x2
2182*/
2183dopower:
2184 power = power*pow*x2;
2185 if ( power < 0 ) { pow = -power; power = -1; }
2186 else if ( power == 0 ) { t = tt; startobject = tt; continue; }
2187 else { pow = power; power = 1; }
2188 *out++ = TPLUS;
2189 if ( pow > 1 ) {
2190 subexp = GenerateFactors(pow,AS.OldNumFactors[nexp]);
2191 if ( subexp < 0 ) { error = -1; subexp = 0; }
2192 *out++ = TSUBEXP; PUTNUMBER128(out,subexp)
2193 *out++ = TMULTIPLY;
2194 }
2195 i = powfactor-1;
2196 if ( i > 0 ) {
2197 *out++ = TSYMBOL; *out++ = FACTORSYMBOL;
2198 if ( i > 1 ) {
2199 *out++ = TPOWER; *out++ = TNUMBER; PUTNUMBER100(out,i)
2200 }
2201 *out++ = TMULTIPLY;
2202 }
2203 powfactor += AS.OldNumFactors[nexp]*pow;
2204 s1 = startobject;
2205 while ( s1 < t ) *out++ = *s1++;
2206 startobject = 0; t = tt; continue;
2207 }
2208 else {
2209 tt = t; pow = 1; x2 = 1; goto dopower;
2210 }
2211 }
2212 else if ( *t == TDOLLAR ) {
2213 startobject = t;
2214 t++;
2215 nexp = 0; while ( *t >= 0 ) { nexp = nexp*128 + *t++; }
2216 if ( *t == LBRACE ) continue;
2217 if ( Dollars[nexp].nfactors == 0 ) continue;
2218 if ( *t == TPOWER ) {
2219 pow = 1;
2220 tt = t+1;
2221 while ( ( *tt == TMINUS ) || ( *tt == TPLUS ) ) {
2222 if ( *tt == TMINUS ) pow = -pow;
2223 tt++;
2224 }
2225 if ( *tt != TNUMBER ) {
2226/* INTERNAL_ERROR_EXCL_START */
2227 MesPrint("!>Internal problems(2) in CodeFactors");
2228 return(-1);
2229/* INTERNAL_ERROR_EXCL_STOP */
2230 }
2231 tt++; x2 = 0; while ( *tt >= 0 ) { x2 = 100*x2 + *tt++; }
2232/*
2233 We have an object in startobject till t. The power is
2234 power*pow*x2
2235*/
2236dopowerd:
2237 power = power*pow*x2;
2238 if ( power < 0 ) { pow = -power; power = -1; }
2239 else if ( power == 0 ) { t = tt; startobject = tt; continue; }
2240 else { pow = power; power = 1; }
2241 if ( pow > 1 ) {
2242 subexp = GenerateFactors(pow,1);
2243 if ( subexp < 0 ) { error = -1; subexp = 0; }
2244 }
2245 for ( i = 1; i <= Dollars[nexp].nfactors; i++ ) {
2246 s1 = startobject; *out++ = TPLUS;
2247 while ( s1 < t ) *out++ = *s1++;
2248 *out++ = LBRACE; *out++ = TNUMBER; PUTNUMBER128(out,i)
2249 *out++ = RBRACE;
2250 *out++ = TMULTIPLY;
2251 *out++ = TSYMBOL; *out++ = FACTORSYMBOL;
2252 *out++ = TPOWER; *out++ = TNUMBER; PUTNUMBER100(out,powfactor)
2253 powfactor += pow;
2254 if ( pow > 1 ) {
2255 *out++ = TSUBEXP; PUTNUMBER128(out,subexp)
2256 }
2257 }
2258 startobject = 0; t = tt; continue;
2259 }
2260 else {
2261 tt = t; pow = 1; x2 = 1; goto dopowerd;
2262 }
2263 }
2264 t++;
2265 }
2266 if ( last == 0 ) { last = 1; goto dolast; }
2267 *out = TENDOFIT;
2268 e->numfactors = powfactor-1;
2269 e->vflags |= ISFACTORIZED;
2270 subexp = CodeGenerator(outtokens);
2271 if ( subexp < 0 ) error = -1;
2272 if ( insubexpbuffers >= MAXSUBEXPRESSIONS ) {
2273 MesPrint("&More than %d subexpressions inside one expression",(WORD)MAXSUBEXPRESSIONS);
2274 Terminate(-1);
2275 }
2276 if ( subexpbuffers+insubexpbuffers >= topsubexpbuffers ) {
2277 DoubleBuffer((void **)((void *)(&subexpbuffers))
2278 ,(void **)((void *)(&topsubexpbuffers)),sizeof(SUBBUF),"subexpbuffers");
2279 }
2280 subexpbuffers[insubexpbuffers].subexpnum = subexp;
2281 subexpbuffers[insubexpbuffers].buffernum = AC.cbufnum;
2282 subexp = insubexpbuffers++;
2283 M_free(outtokens,"CodeFactors");
2284 s1 = tokens;
2285 *s1++ = TSUBEXP; PUTNUMBER128(s1,subexp); *s1++ = TENDOFIT;
2286 if ( error < 0 ) return(-1);
2287 else return(subexp);
2288}
2289
2290/*
2291 #] CodeFactors :
2292 #[ GenerateFactors :
2293
2294 Generates an expression of the type
2295 1+factor_+factor_^2+...+factor_^(n-1)
2296 (this is if inc=1)
2297 Returns the subexpression pointer of it.
2298*/
2299
2300WORD GenerateFactors(WORD n,WORD inc)
2301{
2302 int subexp;
2303 int i, error = 0;
2304 SBYTE *s;
2305 SBYTE *tokenbuffer = (SBYTE *)Malloc1(8*n*sizeof(SBYTE),"GenerateFactors");
2306 s = tokenbuffer;
2307 *s++ = TNUMBER; *s++ = 1;
2308 for ( i = inc; i < n*inc; i += inc ) {
2309 *s++ = TPLUS; *s++ = TSYMBOL; *s++ = FACTORSYMBOL;
2310 if ( i > 1 ) {
2311 *s++ = TPOWER; *s++ = TNUMBER;
2312 PUTNUMBER100(s,i)
2313 }
2314 }
2315 *s++ = TENDOFIT;
2316 subexp = CodeGenerator(tokenbuffer);
2317 if ( subexp < 0 ) error = -1;
2318 M_free(tokenbuffer,"GenerateFactors");
2319 if ( insubexpbuffers >= MAXSUBEXPRESSIONS ) {
2320 MesPrint("&More than %d subexpressions inside one expression",(WORD)MAXSUBEXPRESSIONS);
2321 Terminate(-1);
2322 }
2323 if ( subexpbuffers+insubexpbuffers >= topsubexpbuffers ) {
2324 DoubleBuffer((void **)((void *)(&subexpbuffers))
2325 ,(void **)((void *)(&topsubexpbuffers)),sizeof(SUBBUF),"subexpbuffers");
2326 }
2327 subexpbuffers[insubexpbuffers].subexpnum = subexp;
2328 subexpbuffers[insubexpbuffers].buffernum = AC.cbufnum;
2329 subexp = insubexpbuffers++;
2330 if ( error < 0 ) return(error);
2331 return(subexp);
2332}
2333
2334/*
2335 #] GenerateFactors :
2336 #] Compiler :
2337*/
SkipAName
UBYTE * SkipAName(UBYTE *s)
Definition compiler.c:443
AddRHS
WORD * AddRHS(int num, int type)
Definition comtool.c:210
AddNtoC
int AddNtoC(int bufnum, int n, WORD *array, int par)
Definition comtool.c:313
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